/* test scheme parser by marko riedel, mriedel@neuearbeit.de */ #include #include #include #import "SchemeTypes.h" #import "VScheme.h" id yyresult; static char *forms[] = { "top", "define1", "define2", "set", "lambda1", "lambda2", "quote", "binding", "let", "let*", "letrec", "if1", "if2", "and", "or", "begin", "apply", "case", "scond1", "scond2", "scond3", "cond", "callcc" }; void print_tree(id item, int indent) { int pos; for(pos=0; pos\n"); } else if(c=='\t'){ printf("CHAR: <\\tab>\n"); } else if(c==' '){ printf("CHAR: <\\space>\n"); } else{ printf("CHAR: <%c>\n", c); } } else if([item isKindOfClass:[Int class]]){ printf("INT: %ld\n", [item intVal]); } else if([item isKindOfClass:[Double class]]){ printf("DOUBLE: %le\n", [item doubleVal]); } else if([item isKindOfClass:[Symbol class]]){ printf("SYMBOL: <%s>\n", [[item symVal] cString]); } else if([item isKindOfClass:[String class]]){ printf("STRING: <%s>\n", [[item strVal] cString]); } else if([item isKindOfClass:[Closure class]]){ printf("CLOSURE %s\n", [[VScheme valToString:[item args]] cString]); } else if([item isKindOfClass:[Primitive class]]){ printf("PRIMITIVE\n"); } else if([item isKindOfClass:[Thunk class]]){ printf("THUNK %d %d %d\n", [item argp], [item envp], [item codep]); } else if([item isKindOfClass:[Pair class]]){ printf("PAIR %s\n", [[VScheme valToString:item] cString]); } else if([item isKindOfClass:[NSMutableArray class]]){ printf("CODES: %u\n", [item count]); } else{ printf("FORM %s\n", forms[[item tag]]); if([item arg1]!=nil){ print_tree([item arg1], indent+1); } if([item arg2]!=nil){ print_tree([item arg2], indent+1); } if([item arg3]!=nil){ print_tree([item arg3], indent+1); } } } void print_scheme_item(id item) { print_tree(item, 0); } yyerror(char *s) /* Called by yyparse on error */ { printf ("%s\n", s); } int main(int argc, char **argv) { NSAutoreleasePool *pool = [NSAutoreleasePool new]; NSApplication *theApp; VScheme *vm; id forms, item; GSDebugAllocationActive(YES); vm = [[VScheme alloc] init]; theApp = [NSApplication sharedApplication]; // [theApp run]; setlocale(LC_NUMERIC, "C"); printf("locale %s\n", setlocale(LC_NUMERIC, NULL)); yyparse(); // print_scheme_item(yyresult); [vm setSource:yyresult]; forms = yyresult; while(forms!=[NSNull null]){ NSMutableArray *codes = [NSMutableArray arrayWithCapacity:1]; BOOL err = [vm compile:[forms arg1] output:codes]; print_scheme_item([forms arg1]); if(err==NO){ [VScheme printCodes:codes]; [vm clearOutput]; if([vm run:codes]==YES){ id stack = [vm argStack], envs = [vm envStack], code = [vm codeStack]; int count = 0; while(count<[stack count]){ printf("stack %d: ", count); print_scheme_item([stack objectAtIndex:count++]); } printf("code: %d (%d) pc: %d args: %d (%d) envs: %d (%d):", [code count], [vm maxcode], [vm maxpc], [stack count], [vm maxarg], [envs count], [vm maxenv]); count=0; while(count<[envs count]){ id env = [envs objectAtIndex:count++]; printf("(%d)", [env chainLength]); } putchar('\n'); printf("OUTPUT\n%s\n", [[vm output] cString]); [vm resetStacks]; } else{ printf("run time error: %s\n", [[vm errmsg] cString]); } } else{ printf("compilation failed: %s\n", [[vm errmsg] cString]); } [codes removeAllObjects]; forms = [forms arg2]; } // [pool release]; return 0; }