OBJ
builtin_include(int numArgs){
if( numArgs != 1){
js_error("(include): expects 1 argument", js_nil);
}
OBJ arg1 = POP();
char *fileName;
FILE *theFile;
if( !ISSTRING(arg1) ){
js_error("(include): string arg expected:", arg1);
}
fileName = STRINGVAL(arg1);
theFile = fopen(fileName, "r");
if( theFile == NULL){
js_error("(include): cannot open file:", arg1);
}
OBJ inputStream = newFileStream(theFile);
#ifdef DEBUG
if( PRINT_INCLUDE->state){
printIndent(indentLevelForInclude);
fprintf(stdout, "<include file:" YEL " %s" RESET" >\n", fileName);
indentLevelForInclude++;
}
if( CONTINUATION_PASSING->state){
enterTrampoline1(inputStream);
}
else{
OBJ expr = js_read(inputStream);
OBJ result;
while( expr != js_eof){
result = js_eval(globalEnvironment, expr);
if(PRINT_INCLUDE->state){
printIndent(indentLevelForInclude);
js_print(stdout, result,1);
printf("\n");
}
expr = js_read(inputStream);
}
}
if( PRINT_INCLUDE->state){
indentLevelForInclude--;
printIndent(indentLevelForInclude);
fprintf(stdout, "<EOF:" YEL " %s" RESET" >\n", fileName);
}
#else
enterTrampoline1(inputStream);
#endif
fclose( inputStream->u.fileStream.file );
free( inputStream);
return js_void;
}
static OBJ
builtin_displayOrWrite(int numArgs, int DisplayMode){
if(numArgs > 1){
js_error("(display or write): expects 1 argument", js_nil);
}
OBJ arg = POP();
js_print(stdout, arg, DisplayMode);
return js_void;
}
void
js_error(char* msg, OBJ arg){
fflush(stdout);
fprintf(stderr,RESET "\n-------------\n");
fprintf(stderr,"JS-error: %s ", msg);
js_print(stderr, arg,1);
fprintf(stderr,"\n-------------\n");
getMeOutOfHere();
}
void
jREPL(OBJ input){
/*
* Jojo Scheme REPL
*/
for(;;){
OBJ expr, result;
if(prompt_enabled) printf(CYN "JS> " RESET);
expr = js_read(input); // R ead
result = js_eval(globalEnvironment, expr); // E valuate
if( result == js_eof) return;
js_print(stdout, result, 1); // P rint
// L oop
printf("\n");
}
}
jserr_t js_print(jsparser_t *p, size_t t, Buffer *b, int json) {
jstok_t *tok = js_tok(p, t);
char digitbuf[10];
size_t v;
json = json ? 1 : (js_is_collection(js_tok(p, t)) ? 1 : 0);
switch (tok->type) {
case JS_ARRAY:
buf_append(b, "[", 1);
v = tok->first_child;
while (v) {
if (v != tok->first_child)
buf_append(b, ",", 1);
js_print(p, v, b, json);
v = js_tok(p, v)->next_sibling;
}
buf_append(b, "]", 1);
break;
case JS_OBJECT:
buf_append(b, "{", 1);
v = tok->first_child;
while (v) {
if (v != tok->first_child)
buf_append(b, ",", 1);
js_print(p, v, b, json);
v = js_tok(p, v)->next_sibling;
}
buf_append(b, "}", 1);
break;
case JS_PAIR:
if (!json) {
buf_append(b, (p->js)->buf + tok->start, tok->end - tok->start);
} else {
buf_append(b, "\"", 1);
buf_append(b, (p->js)->buf + tok->start, tok->end - tok->start);
buf_append(b, "\":", 2);
js_print(p, tok->first_child, b, json);
}
break;
case JS_ITEM:
if (!json) {
snprintf(digitbuf, 10, "%ld", tok->idx);
buf_append(b, digitbuf, strlen(digitbuf));
} else {
js_print(p, tok->first_child, b, json);
}
break;
case JS_STRING:
if (json) buf_append(b, "\"", 1);
buf_append(b, (p->js)->buf + tok->start, tok->end - tok->start);
if (json) buf_append(b, "\"", 1);
break;
case JS_NULL:
case JS_TRUE:
case JS_FALSE:
case JS_NUMBER:
buf_append(b, (p->js)->buf + tok->start, tok->end - tok->start);
break;
default:
return JS_EBUG;
}
return 0;
}
OBJ
builtin_define(OBJ env, OBJ argList){
if( !ISCONS(argList) ){
js_error("(define): expects at least 2 arguments", js_nil);
}
OBJ arg1 = CAR(argList);
argList = CDR(argList);
if( !ISCONS(argList) ){
js_error("(define): expects at least 2 arguments", js_nil);
}
// case 1: define SYMBOL -> (define symbol expression)
if( ISSYMBOL(arg1)) {
OBJ arg2 = CAR(argList);
argList = CDR(argList);
if( argList != js_nil ){
js_error("(define): this form expects exactly 2 arguments", js_nil);
}
OBJ value = js_eval(env, arg2);
environmentPut(env, arg1, value);
#ifdef DEBUG
// PRINT TRACE
if( EVAL_TRACE->state) {
printIndent(indentLevel);
fprintf(stdout, RED"DEFINE "RESET);
js_print(stdout, arg1,1);
fprintf(stdout, " -> ");
js_print(stdout, value,1);
if( TAG(env) == T_GLOBALENVIRONMENT ){
fprintf(stdout," in " CYN "GLOBAL" RESET " (%p)\n", env);
}
if( TAG(env) == T_LOCALENVIRONMENT ){
fprintf(stdout," in " YEL "LOCAL" RESET " (%p)\n", env);
}
}
#endif
return js_void;
}
// case 2: define CONS ( function ) -> (define (name args*) (body*) )
if( ISCONS(arg1)){
OBJ name = CAR(arg1);
if( ISSYMBOL(name) ){
OBJ formalArgList = CDR(arg1);
OBJ bodyList = argList;
OBJ newUDF;
newUDF = newUserDefinedFunction("anonymous lambda", formalArgList, bodyList);
newUDF->u.userDefinedFunction.numLocals = count_defines(bodyList);
newUDF->u.userDefinedFunction.home = env;
environmentPut(env, name, newUDF);
#ifdef DEBUG
// PRINT TRACE
if( EVAL_TRACE->state ){
printIndent(indentLevel);
fprintf(stdout, RED"DEFINE "RESET);
js_print(stdout, name,1);
fprintf(stdout, " -> ");
js_print(stdout, newUDF,1);
if( TAG(env) == T_GLOBALENVIRONMENT ){
fprintf(stdout," in " CYN "GLOBAL" RESET " (%p)\n", env);
}
if( TAG(env) == T_LOCALENVIRONMENT ){
fprintf(stdout," in " YEL "LOCAL" RESET " (%p)\n", env);
}
}
#endif
return js_void;
}
}
error("define form unimplemented", __FILE__, __LINE__);
// NOT REACHED
return js_nil;
}
VOIDPTRFUNC
CP_jREPL2(){
//fprintf(stdout, "\nStack in CP_jREPL2:\n");
//printJStack(__FILE__,__LINE__,__FUNCTION__);
DEBUGCODE(PRINT_STACK->state, printJStack(__FILE__,__LINE__,__FUNCTION__));
OBJ result = RETVAL;
#ifdef DEBUG
if( (SP <= 5) || PRINT_INCLUDE->state){
printIndent(indentLevelForInclude);
#else
if( (SP <= 5)) {
#endif
js_print(stdout, result, 1); // P rint
printf("\n");
}
// L oop
OBJ inputStream = ARG(0);
TAILCALL1((VOIDPTRFUNC)CP_jREPL, inputStream);
}
int
main() {
initSymbolTable();
initializeWellKnownObjects();
initJStack();
#ifdef DEBUG
initDebugOptions();
initGlobalEnvironment();
setupInitialEnvironment();
setupBuiltinSyntax();
selftest();
#endif
printf("hello friend...\n");
initGlobalEnvironment();
setupInitialEnvironment();
printf("Welcome to (JS)cheme\n");
if( setjmp(whereEverythingWasFine) ){
#ifdef DEBUG
indentLevel = 0;
indentLevelForInclude = 0;
#endif
// reset Stack index
SP = 0;
AP = 0;
BP = 0;
prompt_on();
printf("back in wonderland\n");
}
printf("...starting a REPL for you.\n");
OBJ inputStream = newFileStream(stdin);
#ifdef DEBUG
if(CONTINUATION_PASSING->state){
CP_setupBuiltinSyntax();
enterTrampoline1(inputStream);
}else{
setupBuiltinSyntax();
jREPL(inputStream);
}
#else
//jREPL(inputStream);
CP_setupBuiltinSyntax();
enterTrampoline1(inputStream);
#endif
return 0;
}