%{ /* compile: leg -o parse.c parse.leg * cc -o parse parse.c * * run: echo "3+4" | ./parse */ #define DO_PROTOS() \ _DO(if) _DO(while) _DO(do) _DO(for) _DO(switch) _DO(call) _DO(invoke) _DO(func) _DO(block) _DO(declaration) \ _DO(assign) _DO(assignAdd) _DO(assignSub) _DO(assignMul) _DO(assignDiv) _DO(assignMod) \ _DO(assignBitor) _DO(assignBitxor) _DO(assignBitand) _DO(assignShleft) _DO(assignShright) \ _DO(map) _DO(symbol) _DO(integer) _DO(string) \ _DO(logor) _DO(logand) _DO(bitor) _DO(bitxor) _DO(bitand) \ _DO(equal) _DO(noteq) _DO(less) _DO(lesseq) _DO(greater) _DO(greatereq) _DO(shleft) _DO(shright) \ _DO(add) _DO(sub) _DO(mul) _DO(div) _DO(mod) _DO(not) _DO(neg) _DO(com) \ _DO(preIncVariable) _DO(preIncMember) _DO(preIncIndex) \ _DO(postIncVariable) _DO(postIncMember) _DO(postIncIndex) \ _DO(preDecVariable) _DO(preDecMember) _DO(preDecIndex) \ _DO(postDecVariable) _DO(postDecMember) _DO(postDecIndex) \ _DO(getVariable) _DO(getMember) _DO(setMember) _DO(getIndex) _DO(setIndex) \ _DO(setMemberAdd) _DO(setMemberSub) _DO(setMemberMul) _DO(setMemberDiv) _DO(setMemberMod) \ _DO(setMemberBitor) _DO(setMemberBitxor) _DO(setMemberBitand) _DO(setMemberShleft) _DO(setMemberShright) \ _DO(setIndexAdd) _DO(setIndexSub) _DO(setIndexMul) _DO(setIndexDiv) _DO(setIndexMod) \ _DO(setIndexBitor) _DO(setIndexBitxor) _DO(setIndexBitand) _DO(setIndexShleft) _DO(setIndexShright) \ _DO(return) _DO(break) _DO(continue) \ _DO(quasiquote) _DO(unquote) typedef enum { t_UNDEFINED=0, #define _DO(NAME) t_##NAME, DO_PROTOS() #undef _DO } proto_t; #define SYMBOL_PAYLOAD proto_t prototype; #include "object.c" #include enum jb_t { j_return = 1, j_break, j_continue, }; typedef struct jb_record { sigjmp_buf jb; oop result; struct jb_record *next; } jb_record; jb_record *jbs= NULL; void jbsCheck(char *msg) { if (NULL == jbs) { fprintf(stderr, "\n%s\n", msg); exit(1); } } jb_record *jbRecPush() { jb_record *newJbRec = memcheck(malloc(sizeof(jb_record))); newJbRec->result = null; newJbRec->next = jbs; jbs = newJbRec; return newJbRec; } jb_record *jbRecPop() { assert(jbs); jb_record *head = jbs; jbs = head->next; return head; } // this is the global scope oop globals= 0; #define DO_SYMBOLS() \ DO_PROTOS() _DO(__proto__) _DO(__name__) _DO(__default__) _DO(__arguments__) \ _DO(name) _DO(body) _DO(param) _DO(key) _DO(value) _DO(condition) _DO(consequent) _DO(alternate) \ _DO(lhs) _DO(rhs) _DO(scope) _DO(args) _DO(expression) _DO(labels) _DO(statements) _DO(initialise) \ _DO(update) _DO(this) _DO(fixed) #define _DO(NAME) oop NAME##_symbol; DO_SYMBOLS() #undef _DO #define _DO(NAME) oop NAME##_proto; DO_PROTOS() #undef _DO int opt_v = 0; int isFalse(oop obj) { return obj == null || (isInteger(obj) && (0 == getInteger(obj))); } int isTrue(oop obj) { return !isFalse(obj); } oop newObject(oop proto) { oop map = makeMap(); map_set(map, __proto___symbol, proto); return map; } void printObjectName(oop object) { assert(is(Map, object)); oop name = map_get(object, __name___symbol); if (name != null) { println(name); return; } oop proto = map_get(object, __proto___symbol); if (proto != null) { printObjectName(proto); } else { fprintf(stderr, "\nThis map has no name\n"); } } // this always creates the key in "object" oop newVariable(oop object, oop key, oop value) { map_set(object, key, value); return value; } // this looks in object and everything in the __proto__ chain until it finds the key oop getVariable(oop object, oop key) { while (!map_hasKey(object, key)) { object = map_get(object, __proto___symbol); if (null == object) { return null; } } return map_get(object, key); } // this follows the __proto__ chain until it finds the key, if it fails it behaves like newMember oop setVariable(oop object, oop key, oop value) { oop obj= object; while (!map_hasKey(obj, key)) { obj= map_get(obj, __proto___symbol); if (null == object) { return map_set(object, key, value); } } return map_set(obj, key, value); } oop newMap(oop value) { oop map = newObject(map_proto); map_set(map, value_symbol, value); return map; } oop newDeclaration(oop name, oop exp) { oop declaration = newObject(declaration_proto); map_set(declaration, lhs_symbol, name); map_set(declaration, rhs_symbol, exp); return declaration; } oop newIf(oop cond, oop cons, oop alt) { oop obj = newObject(if_proto); map_set(obj, condition_symbol, cond); map_set(obj, consequent_symbol, cons); map_set(obj, alternate_symbol, alt); return obj; } oop newWhile(oop cond, oop body) { oop obj = newObject(while_proto); map_set(obj, condition_symbol, cond); map_set(obj, body_symbol, body); return obj; } oop newDo(oop body, oop cond) { oop obj= newObject(do_proto); map_set(obj, body_symbol, body); map_set(obj, condition_symbol, cond); return obj; } oop newFor(oop init, oop cond, oop step, oop body) { oop obj= newObject(for_proto); map_set(obj, initialise_symbol, init); map_set(obj, condition_symbol, cond); map_set(obj, update_symbol, step); map_set(obj, body_symbol, body); return obj; } oop newSwitch(oop expression, oop labels, oop statements) { oop obj= newObject(switch_proto); map_set(obj, expression_symbol, expression); map_set(obj, labels_symbol, labels); map_set(obj, statements_symbol, statements); return obj; } // take char *name or oop already interned? oop newSymbol(oop name) { oop symbol = newObject(symbol_proto); // what is the less confusing, name or value? maybe another word like identifier? map_set(symbol, value_symbol, name); return symbol; } oop newInteger(int value) { oop integer = newObject(integer_proto); map_set(integer, value_symbol, makeInteger(value)); return integer; } int digitValue(int c) { if (c < '0') return -1; if ('a' <= c && c <= 'z') c -= ('a' - 'A'); // tolower(c) if ('9' < c && c < 'A') return -1; if ('Z' < c) return -1; if (c >= 'A') c -= ('A' - 10); else c -= '0'; return c; } int isradix(int r, int c) { c= digitValue(c); return 0 <= c && c < r; } char *unescape(char *s) { char *t= strdup(s); int in= 0, out= 0, c= 0; while (0 != (c= t[in++])) { if ('\\' == c && 0 != (c= t[in])) { ++in; switch (c) { case 'a': c= '\a'; break; case 'b': c= '\b'; break; case 'e': c= '\e'; break; case 'f': c= '\f'; break; case 'n': c= '\n'; break; case 'r': c= '\r'; break; case 't': c= '\t'; break; case 'v': c= '\v'; break; case '0'...'7': { c -= '0'; if (isradix(8, t[in])) c= c * 8 + t[in++] - '0'; if (isradix(8, t[in])) c= c * 8 + t[in++] - '0'; break; } case 'x': { c= 0; if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]); if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]); break; } case 'u': { c= 0; if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]); if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]); if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]); if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]); break; } } } t[out++]= c; } t[out]= 0; return t; } oop newString(oop str) { assert(is(String, str)); oop string = newObject(string_proto); map_set(string, value_symbol, str); return string; } oop newPreIncrement(oop rhs) { assert(is(Map, rhs)); oop proto= map_get(rhs, __proto___symbol); assert(null != proto); oop name= map_get(proto, __name___symbol); assert(null != name); proto_t type= get(name, Symbol, prototype); switch (type) { case t_getVariable: proto= preIncVariable_proto; break; case t_getMember: proto= preIncMember_proto; break; case t_getIndex: proto= preIncIndex_proto; break; default: { printf("\nNon-lvalue after ++: "); println(rhs); exit(1); } } map_set(rhs, __proto___symbol, proto); return rhs; } oop newPostIncrement(oop rhs) { assert(is(Map, rhs)); oop proto= map_get(rhs, __proto___symbol); assert(null != proto); oop name= map_get(proto, __name___symbol); assert(null != name); proto_t type= get(name, Symbol, prototype); switch (type) { case t_getVariable: proto= postIncVariable_proto; break; case t_getMember: proto= postIncMember_proto; break; case t_getIndex: proto= postIncIndex_proto; break; default: { printf("\nNon-lvalue before ++: "); println(rhs); exit(1); } } map_set(rhs, __proto___symbol, proto); return rhs; } oop newPreDecrement(oop rhs) { assert(is(Map, rhs)); oop proto= map_get(rhs, __proto___symbol); assert(null != proto); oop name= map_get(proto, __name___symbol); assert(null != name); proto_t type= get(name, Symbol, prototype); switch (type) { case t_getVariable: proto= preDecVariable_proto; break; case t_getMember: proto= preDecMember_proto; break; case t_getIndex: proto= preDecIndex_proto; break; default: { printf("\nNon-lvalue after ++: "); println(rhs); exit(1); } } map_set(rhs, __proto___symbol, proto); return rhs; } oop newPostDecrement(oop rhs) { assert(is(Map, rhs)); oop proto= map_get(rhs, __proto___symbol); assert(null != proto); oop name= map_get(proto, __name___symbol); assert(null != name); proto_t type= get(name, Symbol, prototype); switch (type) { case t_getVariable: proto= postDecVariable_proto; break; case t_getMember: proto= postDecMember_proto; break; case t_getIndex: proto= postDecIndex_proto; break; default: { printf("\nNon-lvalue before ++: "); println(rhs); exit(1); } } map_set(rhs, __proto___symbol, proto); return rhs; } oop newUnary(oop proto, oop rhs) { oop obj = newObject(proto); map_set(obj, rhs_symbol, rhs); return obj; } oop newBinary(oop proto, oop lhs, oop rhs) { oop obj = newObject(proto); map_set(obj, lhs_symbol, lhs); map_set(obj, rhs_symbol, rhs); return obj; } oop newSetMap(oop proto, oop map, oop key, oop value) { oop obj = newObject(proto); map_set(obj, map_symbol, map); map_set(obj, key_symbol, key); map_set(obj, value_symbol, value); return obj; } oop newGetMap(oop proto, oop map, oop key) { oop obj = newObject(proto); map_set(obj, map_symbol, map); map_set(obj, key_symbol, key); return obj; } oop newGetVariable(oop name) { oop id= newObject(getVariable_proto); map_set(id, key_symbol, name); return id; } oop newFunc(oop name, oop param, oop body, oop fixed) { oop func = newObject(func_proto); map_set(func, name_symbol, name); map_set(func, param_symbol, param); map_set(func, body_symbol, body); map_set(func, fixed_symbol, fixed); return func; } oop apply(oop func, oop args); oop newCall(oop func, oop args) { if (map_get(func, __proto___symbol) == getVariable_proto) { oop key = map_get(func, key_symbol); oop val = getVariable(globals, key); if (is(Function, val) && isTrue(get(val, Function, fixed))) { return apply(val, args); } } oop call = newObject(call_proto); map_set(call, func_symbol, func); map_set(call, args_symbol, args); return call; } oop newInvoke(oop this, oop name, oop args) { oop obj = newObject(invoke_proto); map_set(obj, this_symbol, this); map_set(obj, name_symbol, name); map_set(obj, args_symbol, args); return obj; } oop newBlock(oop statements) { oop obj = newObject(block_proto); map_set(obj, statements_symbol, statements); return obj; } oop newReturn(oop exp) { oop obj = newObject(return_proto); map_set(obj, value_symbol, exp); return obj; } oop newBreak(void) { oop obj = newObject(break_proto); return obj; } oop newContinue(void) { oop obj = newObject(continue_proto); return obj; } oop fold(oop ast); #define YYSTYPE oop YYSTYPE yylval; void error(char *text) { fprintf(stderr, "\nSyntax error near: %s\n", text); exit(1); } oop eval(oop scope, oop ast); %} start = - ( e:stmt { yylval = e } | !. { yylval = 0 } | error ) error = eol* < (!eol .)* eol* (!eol .)* > { error(yytext) } stmt = e:exp SEMICOLON* { $$ = e } | s:block { $$ = newBlock(s) } exp = VAR l:IDENT ASSIGN e:exp { $$ = newDeclaration(l, e) } | VAR l:IDENT { $$ = newDeclaration(l, null) } | FUN l:IDENT p:paramList e:stmt { $$ = newFunc(l, p, e, null) } | FUN p:paramList e:stmt { $$ = newFunc(null, p, e, null) } | SYNTAX l:IDENT p:paramList e:stmt { $$ = newFunc(l, p, e, makeInteger(1)) } | SYNTAX p:paramList e:stmt { $$ = newFunc(null, p, e, makeInteger(1)) } | IF LPAREN c:exp RPAREN t:stmt ELSE f:stmt { $$ = newIf(c, t, f ) } | IF LPAREN c:exp RPAREN t:stmt { $$ = newIf(c, t, null) } | WHILE LPAREN c:exp RPAREN s:stmt { $$ = newWhile(c, s) } | DO s:stmt WHILE LPAREN c:exp RPAREN { $$ = newDo(s, c) } | FOR LPAREN i:stmt c:stmt u:exp RPAREN s:stmt { $$ = newFor(i, c, u, s) } | s:switch { $$ = s } | RETURN e:exp { $$ = newReturn(e) } | RETURN { $$ = newReturn(null) } | BREAK { $$ = newBreak() } | CONTINUE { $$ = newContinue() } | l:IDENT ( ASSIGN e:exp { $$ = newBinary(assign_proto, l, e) } | ASSIGNADD e:exp { $$ = newBinary(assignAdd_proto, l, e) } | ASSIGNSUB e:exp { $$ = newBinary(assignSub_proto, l, e) } | ASSIGNMUL e:exp { $$ = newBinary(assignMul_proto, l, e) } | ASSIGNDIV e:exp { $$ = newBinary(assignDiv_proto, l, e) } | ASSIGNMOD e:exp { $$ = newBinary(assignMod_proto, l, e) } | ASSIGNBITOR e:exp { $$ = newBinary(assignBitor_proto , l, e) } | ASSIGNBITXOR e:exp { $$ = newBinary(assignBitxor_proto, l, e) } | ASSIGNBITAND e:exp { $$ = newBinary(assignBitand_proto, l, e) } | ASSIGNSHLEFT e:exp { $$ = newBinary(assignShleft_proto , l, e) } | ASSIGNSHRIGHT e:exp { $$ = newBinary(assignShright_proto, l, e) } ) | l:postfix DOT i:IDENT ( ASSIGN e:exp { $$ = newSetMap(setMember_proto, l, i, e) } | ASSIGNADD e:exp { $$ = newSetMap(setMemberAdd_proto, l, i, e) } | ASSIGNSUB e:exp { $$ = newSetMap(setMemberSub_proto, l, i, e) } | ASSIGNMUL e:exp { $$ = newSetMap(setMemberMul_proto, l, i, e) } | ASSIGNDIV e:exp { $$ = newSetMap(setMemberDiv_proto, l, i, e) } | ASSIGNMOD e:exp { $$ = newSetMap(setMemberMod_proto, l, i, e) } | ASSIGNBITOR e:exp { $$ = newSetMap(setMemberBitor_proto, l, i, e) } | ASSIGNBITXOR e:exp { $$ = newSetMap(setMemberBitxor_proto, l, i, e) } | ASSIGNBITAND e:exp { $$ = newSetMap(setMemberBitand_proto, l, i, e) } | ASSIGNSHLEFT e:exp { $$ = newSetMap(setMemberShleft_proto, l, i, e) } | ASSIGNSHRIGHT e:exp { $$ = newSetMap(setMemberShright_proto, l, i, e) } ) | l:postfix LBRAC i:exp RBRAC ( ASSIGN e:exp { $$ = newSetMap(setIndex_proto, l, i, e) } | ASSIGNADD e:exp { $$ = newSetMap(setIndexAdd_proto, l, i, e) } | ASSIGNSUB e:exp { $$ = newSetMap(setIndexSub_proto, l, i, e) } | ASSIGNMUL e:exp { $$ = newSetMap(setIndexMul_proto, l, i, e) } | ASSIGNDIV e:exp { $$ = newSetMap(setIndexDiv_proto, l, i, e) } | ASSIGNMOD e:exp { $$ = newSetMap(setIndexMod_proto, l, i, e) } | ASSIGNBITOR e:exp { $$ = newSetMap(setIndexBitor_proto, l, i, e) } | ASSIGNBITXOR e:exp { $$ = newSetMap(setIndexBitxor_proto, l, i, e) } | ASSIGNBITAND e:exp { $$ = newSetMap(setIndexBitand_proto, l, i, e) } | ASSIGNSHLEFT e:exp { $$ = newSetMap(setIndexShleft_proto, l, i, e) } | ASSIGNSHRIGHT e:exp { $$ = newSetMap(setIndexShright_proto, l, i, e) } ) | c:cond { $$ = c } block = LCB m:makeMap ( s:stmt { map_append(m, s) } ) * RCB { $$ = m } switch = SWITCH LPAREN e:exp RPAREN LCB statements:makeMap labels:makeMap ( CASE l:exp COLON { map_set(labels, fold(l), makeInteger(map_size(statements))) } | DEFAULT COLON { map_set(labels, __default___symbol, makeInteger(map_size(statements))) } | s:stmt { map_append(statements, s) } )* RCB { $$= newSwitch(e, labels, statements) } cond = c:logor QUERY t:exp COLON f:cond { $$ = newIf(c, t, f) } | logor logor = l:logand ( LOGOR r:logand { l = newBinary(logor_proto, l, r) } )* { $$ = l } logand = l:bitor ( LOGAND r:bitor { l = newBinary(logand_proto, l, r) } )* { $$ = l } bitor = l:bitxor ( BITOR r:bitxor { l = newBinary(bitor_proto, l, r) } )* { $$ = l } bitxor = l:bitand ( BITXOR r:bitand { l = newBinary(bitxor_proto, l, r) } )* { $$ = l } bitand = l:eq ( BITAND r:eq { l = newBinary(bitand_proto, l, r) } )* { $$ = l } eq = l:ineq ( EQUAL r:ineq { l = newBinary(equal_proto, l, r) } | NOTEQ r:ineq { l = newBinary(noteq_proto, l, r) } )* { $$ = l } ineq = l:shift ( LESS r:shift { l = newBinary(less_proto, l, r) } | LESSEQ r:shift { l = newBinary(lesseq_proto, l, r) } | GREATEREQ r:shift { l = newBinary(greatereq_proto, l, r) } | GREATER r:shift { l = newBinary(greater_proto, l, r) } )* { $$ = l } shift = l:sum ( SHLEFT r:sum { l = newBinary(shleft_proto, l, r) } | SHRIGHT r:sum { l = newBinary(shright_proto, l, r) } )* { $$ = l } sum = l:prod ( PLUS r:prod { l = newBinary(add_proto, l, r) } | MINUS r:prod { l = newBinary(sub_proto, l, r) } )* { $$ = l } prod = l:prefix ( MULTI r:prefix { l = newBinary(mul_proto, l, r) } | DIVIDE r:prefix { l = newBinary(div_proto, l, r) } | MODULO r:prefix { l = newBinary(mod_proto, l, r) } )* { $$ = l } prefix = PLUS n:prefix { $$= n } | MINUS n:prefix { $$= newUnary(neg_proto, n) } | TILDE n:prefix { $$= newUnary(com_proto, n) } | PLING n:prefix { $$= newUnary(not_proto, n) } | PLUSPLUS n:prefix { $$= newPreIncrement(n) } | MINUSMINUS n:prefix { $$= newPreDecrement(n) } | BACKTICK n:prefix { $$ = newUnary(quasiquote_proto, n) } | AT n:prefix { $$ = newUnary(unquote_proto, n) } | n:postfix { $$= n } postfix = i:value ( DOT s:IDENT a:argumentList { i = newInvoke(i, s, a) } | DOT s:IDENT !assignOp { i = newGetMap(getMember_proto, i, s) } | LBRAC p:exp RBRAC !assignOp { i = newGetMap(getIndex_proto, i, p) } | a:argumentList { i = newCall(i, a) } | PLUSPLUS { i = newPostIncrement(i) } | MINUSMINUS { i = newPostDecrement(i) } ) * { $$ = i } assignOp = ASSIGN | ASSIGNADD | ASSIGNSUB | ASSIGNMUL | ASSIGNDIV | ASSIGNMOD | ASSIGNBITOR | ASSIGNBITXOR | ASSIGNBITAND | ASSIGNSHLEFT | ASSIGNSHRIGHT paramList = LPAREN m:makeMap ( i:IDENT { map_append(m, i) } ( COMMA i:IDENT { map_append(m, i) } ) * ) ? RPAREN { $$ = m } argumentList = LPAREN m:makeMap ( e:exp { map_append(m, e) } ( COMMA e:exp { map_append(m, e) } ) * ) ? RPAREN { $$ = m } value = n:NUMBER { $$ = n } | s:STRING { $$ = newString(s) } | s:symbol { $$ = s } | m:map { $$ = newMap(m) } | NULL { $$ = null } | i:IDENT { $$ = newGetVariable(i) } | LPAREN i:exp RPAREN { $$ = i } STRING = SQUOTE < (!SQUOTE char)* > SQUOTE { $$ = makeString(unescape(yytext)) } | DQUOTE < (!DQUOTE char)* > DQUOTE { $$ = makeString(unescape(yytext)) } char = '\\' . | . symbol = HASH ( i:IDENT { $$ = newSymbol(i) } | i:STRING { $$ = newSymbol(intern(get(i, String, value))) } ) map = LCB m:makeMap ( k:IDENT COLON v:exp { map_set(m, k, v) } ( COMMA k:IDENT COLON v:exp { map_set(m, k, v) } ) * ) ? RCB { $$ = m } makeMap= { $$ = makeMap() } - = (blank | comment)* blank = space | eol space = [ \t] eol = "\n""\r"* | "\r""\n"* comment = "//" ( ![\n\r] . )* | "/*" ( !"*/" . )* "*/" keyword = FUN | SYNTAX | VAR | SWITCH | CASE | DEFAULT | DO | FOR | WHILE | IF | ELSE | NULL | RETURN | BREAK | CONTINUE IDENT = !keyword < [a-zA-Z_][a-zA-Z0-9_]* > - { $$ = intern(yytext) } NUMBER = '0b' < [01]+ > - { $$ = newInteger(strtol(yytext, 0, 2)) } | '0x' < [0-9a-fA-F]+ > - { $$ = newInteger(strtol(yytext, 0, 16)) } | '0' < [0-7]+ > - { $$ = newInteger(strtol(yytext, 0, 8)) } | < [0-9]+ > - { $$ = newInteger(strtol(yytext, 0, 10)) } FUN = 'fun' ![a-zA-Z0-9_] - SYNTAX = 'syntax' ![a-zA-Z0-9_] - VAR = 'var' ![a-zA-Z0-9_] - SWITCH = 'switch' ![a-zA-Z0-9_] - CASE = 'case' ![a-zA-Z0-9_] - DEFAULT = 'default' ![a-zA-Z0-9_] - DO = 'do' ![a-zA-Z0-9_] - FOR = 'for' ![a-zA-Z0-9_] - WHILE = 'while' ![a-zA-Z0-9_] - IF = 'if' ![a-zA-Z0-9_] - ELSE = 'else' ![a-zA-Z0-9_] - NULL = 'null' ![a-zA-Z0-9_] - RETURN = 'return' ![a-zA-Z0-9_] - BREAK = 'break' ![a-zA-Z0-9_] - CONTINUE = 'continue' ![a-zA-Z0-9_] - HASH = '#' - LOGOR = '||' - LOGAND = '&&' - BITOR = '|' ![|=] - BITXOR = '^' ![=] - BITAND = '&' ![&=] - EQUAL = '==' - NOTEQ = '!=' - LESS = '<' ![<=] - LESSEQ = '<=' - GREATEREQ = '>=' - GREATER = '>' ![>=] - SHLEFT = '<<' ![=] - SHRIGHT = '>>' ![=] - PLUS = '+' ![+=] - MINUS = '-' ![-=] - PLUSPLUS = '++' - MINUSMINUS = '--' - TILDE = '~' - PLING = '!' ![=] - MULTI = '*' ![=] - DIVIDE = '/' ![/=] - MODULO = '%' ![=] - ASSIGN = '=' ![=] - ASSIGNADD = '+=' - ASSIGNSUB = '-=' - ASSIGNMUL = '*=' - ASSIGNDIV = '/=' - ASSIGNMOD = '%=' - ASSIGNBITOR ='|=' - ASSIGNBITXOR='^=' - ASSIGNBITAND='&=' - ASSIGNSHLEFT='<<=' - ASSIGNSHRIGHT='>>=' - QUERY = '?' - COLON = ':' - SEMICOLON = ';' - COMMA = ',' - DOT = '.' - BACKTICK= '`' - AT = '@' - LCB = '{' - RCB = '}' - LBRAC = '[' - RBRAC = ']' - LPAREN = '(' - RPAREN = ')' - DQUOTE = '"' - SQUOTE = "'" - %% ; oop map_zip(oop keys, oop values) { assert(is(Map, keys)); assert(is(Map, values)); oop map= makeMap(); for (int i= 0; map_hasIntegerKey(keys, i) && map_hasIntegerKey(values, i); ++i) { oop key = get(keys, Map, elements)[i].value; oop value = get(values, Map, elements)[i].value; map_set(map, key, value); } return map; } oop clone(oop obj) { switch(getType(obj)) { case Undefined: case Integer: case Function: case Symbol: return obj; case String: return makeString(get(obj, String, value)); case Map: { struct Pair *elements= malloc(sizeof(struct Pair) * get(obj, Map, capacity)); memcpy(elements, get(obj, Map, elements), sizeof(struct Pair) * get(obj, Map, capacity)); oop map= malloc(sizeof(*obj)); memcpy(map, obj, sizeof(*obj)); set(map, Map, elements, elements); return map; } } return obj; } oop expandUnquotes(oop scope, oop obj) { obj = clone(obj); if (!is(Map, obj)) { return obj; } if (map_get(obj, __proto___symbol) == unquote_proto) { return eval(scope, map_get(obj, rhs_symbol)); } for (size_t i= 0; i < map_size(obj); ++i) { struct Pair *pair= &get(obj, Map, elements)[i]; pair->value= expandUnquotes(scope, pair->value); } return obj; } oop fold(oop ast) { if (is(Map, ast)) { oop proto= map_get(ast, __proto___symbol); if (null != proto) { proto_t proto_number= get(map_get(proto, __name___symbol), Symbol, prototype); switch (proto_number) { case t_integer: case t_string: case t_symbol: { return map_get(ast, value_symbol); } case t_logor: { oop lhs= map_get(ast, lhs_symbol); oop rhs= map_get(ast, rhs_symbol); if (isTrue(fold(lhs))) return makeInteger(1); if (isTrue(fold(rhs))) return makeInteger(1); return makeInteger(0); } case t_logand: { oop lhs= map_get(ast, lhs_symbol); oop rhs= map_get(ast, rhs_symbol); if (isFalse(fold(lhs))) return makeInteger(0); if (isFalse(fold(rhs))) return makeInteger(0); return makeInteger(1); } # define BINARY(NAME, OPERATOR) \ case t_##NAME: { \ oop lhs= fold(map_get(ast, lhs_symbol)); \ oop rhs= fold(map_get(ast, rhs_symbol)); \ return makeInteger(getInteger(lhs) OPERATOR getInteger(rhs)); \ } BINARY(bitor, | ); BINARY(bitxor, ^ ); BINARY(bitand, & ); BINARY(equal, ==); BINARY(noteq, !=); BINARY(less, < ); BINARY(lesseq, <=); BINARY(greatereq, >=); BINARY(greater, > ); BINARY(shleft, <<); BINARY(shright, >>); BINARY(add, + ); BINARY(sub, - ); BINARY(mul, * ); BINARY(div, / ); BINARY(mod, % ); # undef BINARY # define UNARY(NAME, OPERATOR) \ case t_##NAME: { \ oop rhs = fold(map_get(ast, rhs_symbol)); \ return makeInteger(OPERATOR getInteger(rhs)); \ } UNARY(not, !); UNARY(neg, -); UNARY(com, ~); # undef UNARY default: break; } } } printf("illegal value in constant expression: "); println(ast); assert(0); return null; } oop evalArgs(oop scope, oop args); oop eval(oop scope, oop ast) { if (opt_v) { printf("EVAL: "); println(ast); } switch(getType(ast)) { case Undefined: case Integer: case String: case Function: return ast; case Symbol: return getVariable(scope, ast); case Map: break; } assert(is(Map, ast)); oop proto = map_get(ast, __proto___symbol); if (proto == null) { return ast; } // proto_number is the enum version of the proto symbol proto_t proto_number = get(map_get(proto, __name___symbol), Symbol, prototype); switch (proto_number) { case t_UNDEFINED: { assert(0); return 0; } case t_map: { oop map= clone(map_get(ast, value_symbol)); for (size_t i= 0; i < map_size(map); ++i) { struct Pair *pair= &get(map, Map, elements)[i]; pair->value= eval(scope, pair->value); } return map; } case t_quasiquote: { oop obj = map_get(ast, rhs_symbol); return expandUnquotes(scope, obj); } case t_unquote: { fprintf(stderr, "\n@ outside of `\n"); exit(1); } case t_declaration: { oop lhs = map_get(ast, lhs_symbol); oop rhs = eval(scope, map_get(ast, rhs_symbol)); return newVariable(scope, lhs, rhs); } case t_if: { oop condition = map_get(ast, condition_symbol ); oop consequent = map_get(ast, consequent_symbol); oop alternate = map_get(ast, alternate_symbol ); return eval(scope, isTrue(eval(scope, condition)) ? consequent : alternate); } case t_while: { oop condition = map_get(ast, condition_symbol ); oop body = map_get(ast, body_symbol); oop result = null; jbRecPush(); int jbt = sigsetjmp(jbs->jb, 0); switch (jbt) { case j_return: { oop result = jbs->result; jbRecPop(); jbsCheck("return outside a function"); jbs->result = result; siglongjmp(jbs->jb, j_return); assert(0); } case j_break: { jbRecPop(); return null; } case j_continue: { break; } } while (isTrue(eval(scope, condition))) result= eval(scope, body); jbRecPop(); return result; } case t_do: { oop body = map_get(ast, body_symbol); oop condition = map_get(ast, condition_symbol ); oop result = null; jbRecPush(); int jbt = sigsetjmp(jbs->jb, 0); switch (jbt) { case j_return: { oop result = jbs->result; jbRecPop(); jbsCheck("return outside a function"); jbs->result = result; siglongjmp(jbs->jb, j_return); assert(0); } case j_break: { jbRecPop(); return null; } case j_continue: { goto restart_do; } } do { result= eval(scope, body); restart_do:; } while (isTrue(eval(scope, condition))); jbRecPop(); return result; } case t_for: { oop initialise = map_get(ast, initialise_symbol ); oop condition = map_get(ast, condition_symbol ); oop update = map_get(ast, update_symbol ); oop body = map_get(ast, body_symbol); oop result = null; oop localScope = newObject(scope); jbRecPush(); int jbt = sigsetjmp(jbs->jb, 0); switch (jbt) { case j_return: { oop result = jbs->result; jbRecPop(); jbsCheck("return outside a function"); jbs->result = result; siglongjmp(jbs->jb, j_return); assert(0); } case j_break: { jbRecPop(); return null; } case j_continue: { goto restart_for; } } for (eval(localScope, initialise); isTrue(eval(localScope, condition)); eval(localScope, update)) { result= eval(localScope, body); restart_for:; } return result; } case t_switch: { oop expression = map_get(ast, expression_symbol ); oop labels = map_get(ast, labels_symbol ); oop statements = map_get(ast, statements_symbol ); oop result = eval(scope, expression); oop label = map_get(labels, result); if (null == label) label= map_get(labels, __default___symbol); if (null == label) return result; assert(isInteger(label)); int limit= map_size(statements); jbRecPush(); int jbt = sigsetjmp(jbs->jb, 0); switch (jbt) { case j_return: { oop result = jbs->result; jbRecPop(); jbsCheck("return outside a function"); jbs->result = result; siglongjmp(jbs->jb, j_return); assert(0); } case j_break: { jbRecPop(); return null; } case j_continue: { jbRecPop(); jbsCheck("continue outside a loop"); siglongjmp(jbs->jb, j_continue); assert(0); } } for (int i= getInteger(label); i < limit; ++i) { assert(map_hasIntegerKey(statements, i)); result= eval(scope, get(statements, Map, elements)[i].value); } return result; } case t_assign: { oop lhs = map_get(ast, lhs_symbol); oop rhs = eval(scope, map_get(ast, rhs_symbol)); setVariable(scope, lhs, rhs); if (is(Function, rhs) && null == get(rhs, Function, name)) { set(rhs, Function, name, lhs); } return rhs; } case t_func: { oop name = map_get(ast, name_symbol); oop param = map_get(ast, param_symbol); oop body = map_get(ast, body_symbol); oop fixed = map_get(ast, fixed_symbol); oop func = makeFunction(NULL, name, param, body, scope, fixed); if (opt_v) { printf("funcscope: "); println(scope); printf("globalScope: "); println(scope); } if (name != null) newVariable(scope, name, func); return func; } case t_call: { oop func = eval(scope, map_get(ast, func_symbol)); if (!is(Function, func)) { printf("cannot call "); println(func); exit(1); } oop args = map_get(ast, args_symbol); if (isFalse(get(func, Function, fixed))) { args = evalArgs(scope, args); } if (get(func, Function, primitive) == NULL) { oop param = get(func, Function, param); oop localScope = map_zip(param, args); map_set(localScope, __arguments___symbol, args); map_set(localScope, __proto___symbol, get(func, Function, parentScope)); if (opt_v) { printf("parentScope: "); println(get(func, Function, parentScope)); printf("localScope: "); println(localScope); } jbRecPush(); int jbt = sigsetjmp(jbs->jb, 0); switch (jbt) { case j_return: { oop result = jbs->result; jbRecPop(); return result; } case j_break: { fprintf(stderr, "\nbreak outside of a loop\n"); exit(1); } case j_continue: { fprintf(stderr, "\ncontinue outside of a loop\n"); exit(1); } } oop result = eval(localScope, get(func, Function, body)); jbRecPop(); return result; } return get(func, Function, primitive)(args); } case t_invoke: { // this is what differs from t_call oop this = eval(scope, map_get(ast, this_symbol)); oop func = getVariable(this, map_get(ast, name_symbol)); if (!is(Function, func)) { printf("cannot invoke "); println(func); exit(1); } oop args = evalArgs(scope, map_get(ast, args_symbol)); if (NULL != get(func, Function, primitive)) { return get(func, Function, primitive)(args); } oop param = get(func, Function, param); oop localScope = map_zip(param, args); // and set this in the local scope map_set(localScope, this_symbol, this); map_set(localScope, __arguments___symbol, args); map_set(localScope, __proto___symbol, get(func, Function, parentScope)); if (opt_v) { printf("parentScope: "); println(get(func, Function, parentScope)); printf("localScope: "); println(localScope); } jbRecPush(); int jbt = sigsetjmp(jbs->jb, 0); switch (jbt) { case j_return: { oop result = jbs->result; jbRecPop(); return result; } case j_break: { fprintf(stderr, "\nbreak outside of a loop\n"); exit(1); } case j_continue: { fprintf(stderr, "\ncontinue outside of a loop\n"); exit(1); } } oop result = eval(localScope, get(func, Function, body)); jbRecPop(); return result; } case t_return: { jbsCheck("return outside a function"); jbs->result = eval(scope, map_get(ast, value_symbol)); siglongjmp(jbs->jb, j_return); } case t_break: { jbsCheck("break outside a loop"); siglongjmp(jbs->jb, j_break); } case t_continue: { jbsCheck("continue outside a loop"); siglongjmp(jbs->jb, j_continue); } case t_block: { oop statements = map_get(ast, statements_symbol); int i = 0; oop index; oop statement, res; oop localScope = newObject(scope); while ((index = makeInteger(i)), map_hasKey(statements, index)) { statement = map_get(statements, index); res = eval(localScope, statement); i++; } return res; } case t_getVariable: { return getVariable(scope, map_get(ast, key_symbol)); } case t_getMember: { oop map = eval(scope, map_get(ast, map_symbol)); oop key = map_get(ast, key_symbol); return getVariable(map, key); } case t_setMember: { oop map = eval(scope, map_get(ast, map_symbol)); oop key = map_get(ast, key_symbol); oop value = eval(scope, map_get(ast, value_symbol)); if (is(Function, value) && null == get(value, Function, name)) { set(value, Function, name, key); } return map_set(map, key, value); } # define SETMEMBEROP(OPERATION, OPERATOR) \ case t_setMember##OPERATION: { \ oop map = eval(scope, map_get(ast, map_symbol)); \ oop key = map_get(ast, key_symbol); \ oop value = eval(scope, map_get(ast, value_symbol)); \ return map_set(map, key, makeInteger(getInteger(getVariable(map, key)) OPERATOR getInteger(value))); \ } SETMEMBEROP(Add, +); SETMEMBEROP(Sub, -); SETMEMBEROP(Mul, *); SETMEMBEROP(Div, /); SETMEMBEROP(Mod, %); SETMEMBEROP(Bitor, |); SETMEMBEROP(Bitxor, ^); SETMEMBEROP(Bitand, &); SETMEMBEROP(Shleft, <<); SETMEMBEROP(Shright, >>); # undef SETMEMBEROP case t_getIndex: { oop map = eval(scope, map_get(ast, map_symbol)); oop key = eval(scope, map_get(ast, key_symbol)); return map_get(map, key); } case t_setIndex: { oop map = eval(scope, map_get(ast, map_symbol)); oop key = eval(scope, map_get(ast, key_symbol)); oop value = eval(scope, map_get(ast, value_symbol)); return map_set(map, key, value); } # define SETINDEXOP(OPERATION, OPERATOR) \ case t_setIndex##OPERATION: { \ oop map = eval(scope, map_get(ast, map_symbol)); \ oop key = eval(scope, map_get(ast, key_symbol)); \ oop value = eval(scope, map_get(ast, value_symbol)); \ return map_set(map, key, makeInteger(getInteger(getVariable(map, key)) OPERATOR getInteger(value))); \ } SETINDEXOP(Add, +); SETINDEXOP(Sub, -); SETINDEXOP(Mul, *); SETINDEXOP(Div, /); SETINDEXOP(Mod, %); SETINDEXOP(Bitor, |); SETINDEXOP(Bitxor, ^); SETINDEXOP(Bitand, &); SETINDEXOP(Shleft, <<); SETINDEXOP(Shright, >>); # undef SETINDEXOP case t_symbol: case t_integer: case t_string: { return map_get(ast, value_symbol); } case t_logor: { oop lhs = map_get(ast, lhs_symbol); oop rhs = map_get(ast, rhs_symbol); if (isTrue(eval(scope, lhs))) return makeInteger(1); if (isTrue(eval(scope, rhs))) return makeInteger(1); return makeInteger(0); } case t_logand: { oop lhs = map_get(ast, lhs_symbol); oop rhs = map_get(ast, rhs_symbol); if (isFalse(eval(scope, lhs))) return makeInteger(0); if (isFalse(eval(scope, rhs))) return makeInteger(0); return makeInteger(1); } # define ASSIGNOP(OPERATION, OPERATOR) \ case t_assign##OPERATION: { \ oop lhs = map_get(ast, lhs_symbol); \ oop rhs = eval(scope, map_get(ast, rhs_symbol)); \ oop result = makeInteger(getInteger(eval(scope, lhs)) OPERATOR getInteger(rhs)); \ return setVariable(scope, lhs, result); \ } ASSIGNOP(Add, +); ASSIGNOP(Sub, -); ASSIGNOP(Mul, *); ASSIGNOP(Div, /); ASSIGNOP(Mod, %); ASSIGNOP(Bitor, |); ASSIGNOP(Bitxor, ^); ASSIGNOP(Bitand, &); ASSIGNOP(Shleft, <<); ASSIGNOP(Shright, >>); # undef ASSIGNOP # define BINARY(NAME, OPERATOR) \ case t_##NAME: { \ oop lhs = eval(scope, map_get(ast, lhs_symbol)); \ oop rhs = eval(scope ,map_get(ast, rhs_symbol)); \ return makeInteger(getInteger(lhs) OPERATOR getInteger(rhs)); \ } BINARY(bitor, | ); BINARY(bitxor, ^ ); BINARY(bitand, & ); BINARY(equal, ==); BINARY(noteq, !=); BINARY(less, < ); BINARY(lesseq, <=); BINARY(greatereq, >=); BINARY(greater, > ); BINARY(shleft, <<); BINARY(shright, >>); BINARY(add, + ); BINARY(sub, - ); BINARY(mul, * ); BINARY(div, / ); BINARY(mod, % ); # undef BINARY case t_not: { oop rhs = eval(scope, map_get(ast, rhs_symbol)); return makeInteger(isFalse(rhs)); } # define UNARY(NAME, OPERATOR) \ case t_##NAME: { \ oop rhs = eval(scope, map_get(ast, rhs_symbol)); \ return makeInteger(OPERATOR getInteger(rhs)); \ } UNARY(neg, -); UNARY(com, ~); # undef UNARY case t_preIncVariable: { oop key= map_get(ast, key_symbol); oop val= getVariable(scope, key); val= makeInteger(getInteger(val) + 1); return setVariable(scope, key, val); } case t_preDecVariable: { oop key= map_get(ast, key_symbol); oop val= getVariable(scope, key); val= makeInteger(getInteger(val) - 1); return setVariable(scope, key, val); } case t_preIncMember: { oop map= eval(scope, map_get(ast, map_symbol)); oop key= map_get(ast, key_symbol); oop val= map_get(map, key); val= makeInteger(getInteger(val) + 1); return map_set(map, key, val); } case t_preDecMember: { oop map= eval(scope, map_get(ast, map_symbol)); oop key= map_get(ast, key_symbol); oop val= map_get(map, key); val= makeInteger(getInteger(val) - 1); return map_set(map, key, val); } case t_preIncIndex: { oop map= eval(scope, map_get(ast, map_symbol)); oop key= eval(scope, map_get(ast, key_symbol)); oop val= map_get(map, key); val= makeInteger(getInteger(val) + 1); return map_set(map, key, val); } case t_preDecIndex: { oop map= eval(scope, map_get(ast, map_symbol)); oop key= eval(scope, map_get(ast, key_symbol)); oop val= map_get(map, key); val= makeInteger(getInteger(val) - 1); return map_set(map, key, val); } case t_postIncVariable: { oop key= map_get(ast, key_symbol); oop val= getVariable(scope, key); oop inc= makeInteger(getInteger(val) + 1); setVariable(scope, key, inc); return val; } case t_postDecVariable: { oop key= map_get(ast, key_symbol); oop val= getVariable(scope, key); oop inc= makeInteger(getInteger(val) - 1); setVariable(scope, key, inc); return val; } case t_postIncMember: { oop map= eval(scope, map_get(ast, map_symbol)); oop key= map_get(ast, key_symbol); oop val= map_get(map, key); oop inc= makeInteger(getInteger(val) + 1); map_set(map, key, inc); return val; } case t_postDecMember: { oop map= eval(scope, map_get(ast, map_symbol)); oop key= map_get(ast, key_symbol); oop val= map_get(map, key); oop inc= makeInteger(getInteger(val) - 1); map_set(map, key, inc); return val; } case t_postIncIndex: { oop map= eval(scope, map_get(ast, map_symbol)); oop key= eval(scope, map_get(ast, key_symbol)); oop val= map_get(map, key); oop inc= makeInteger(getInteger(val) + 1); map_set(map, key, inc); return val; } case t_postDecIndex: { oop map= eval(scope, map_get(ast, map_symbol)); oop key= eval(scope, map_get(ast, key_symbol)); oop val= map_get(map, key); oop inc= makeInteger(getInteger(val) - 1); map_set(map, key, inc); return val; } } printf("EVAL "); println(ast); assert(0); return null; } oop prim_exit(oop params) { int status= 0; if (map_hasIntegerKey(params, 0)) { oop arg= get(params, Map, elements)[0].value; if (isInteger(arg)) status= getInteger(arg); } exit(status); } oop prim_keys(oop params) { if (map_hasIntegerKey(params, 0)) { oop arg= get(params, Map, elements)[0].value; if (is(Map, arg)) return map_keys(arg); } return null; } oop prim_length(oop params) { if (map_hasIntegerKey(params, 0)) { oop arg= get(params, Map, elements)[0].value; switch (getType(arg)) { case String: return makeInteger(strlen(get(arg, String, value))); case Symbol: return makeInteger(strlen(get(arg, Symbol, name))); case Map: return makeInteger(map_size(arg)); default: break; } } return null; } oop prim_invoke(oop params) { oop this= null; if (map_hasIntegerKey(params, 0)) this= get(params, Map, elements)[0].value; oop func= null; if (map_hasIntegerKey(params, 1)) func= get(params, Map, elements)[1].value; oop args= null; if (map_hasIntegerKey(params, 2)) args= get(params, Map, elements)[2].value; if (!is(Function, func)) { printf("cannot invoke "); println(func); exit(1); } if (NULL != get(func, Function, primitive)) { return get(func, Function, primitive)(args); } oop param = get(func, Function, param); oop localScope = map_zip(param, args); map_set(localScope, this_symbol, this); map_set(localScope, __arguments___symbol, args); map_set(localScope, __proto___symbol, get(func, Function, parentScope)); jbRecPush(); int jbt = sigsetjmp(jbs->jb, 0); switch (jbt) { case j_return: { oop result = jbs->result; jbRecPop(); return result; } case j_break: { fprintf(stderr, "\nbreak outside of a loop\n"); exit(1); } case j_continue: { fprintf(stderr, "\ncontinue outside of a loop\n"); exit(1); } } oop result= eval(localScope, get(func, Function, body)); jbRecPop(); return result; } oop apply(oop func, oop args) { if (!is(Function, func)) { printf("cannot apply "); println(func); exit(1); } if (NULL != get(func, Function, primitive)) { return get(func, Function, primitive)(args); } oop param = get(func, Function, param); oop localScope = map_zip(param, args); map_set(localScope, __arguments___symbol, args); map_set(localScope, __proto___symbol, get(func, Function, parentScope)); jbRecPush(); int jbt = sigsetjmp(jbs->jb, 0); switch (jbt) { case j_return: { oop result = jbs->result; jbRecPop(); return result; } case j_break: { fprintf(stderr, "\nbreak outside of a loop\n"); exit(1); } case j_continue: { fprintf(stderr, "\ncontinue outside of a loop\n"); exit(1); } } oop result= eval(localScope, get(func, Function, body)); jbRecPop(); return result; } oop prim_apply(oop params) { oop func= null; if (map_hasIntegerKey(params, 0)) func= get(params, Map, elements)[0].value; oop args= null; if (map_hasIntegerKey(params, 1)) args= get(params, Map, elements)[1].value; return apply(func, args); } oop prim_clone(oop params) { if (map_hasIntegerKey(params, 0)) return clone(get(params, Map, elements)[0].value); return null; } oop prim_print(oop params) { assert(is(Map, params)); for (int i= 0; map_hasIntegerKey(params, i); ++i) { print(get(params, Map, elements)[i].value); } return params; } oop evalArgs(oop scope, oop args) { int i = 0; oop params = makeMap(); oop index; while ((index = makeInteger(i)), map_hasKey(args, index)) { map_set(params, index, eval(scope, map_get(args, index))); i++; } return params; } int main(int argc, char **argv) { # if (USE_GC) GC_INIT(); # endif while (argc-- > 1) { ++argv; if (!strcmp(*argv, "-v")) ++opt_v; else { fprintf(stderr, "unknown option: %s\n", *argv); } } symbol_table = makeMap(); globals = makeMap(); map_set(globals, intern("exit") , makeFunction(prim_exit, intern("exit"), null, null, globals, null)); map_set(globals, intern("keys") , makeFunction(prim_keys, intern("keys"), null, null, globals, null)); map_set(globals, intern("length"), makeFunction(prim_length, intern("length"), null, null, globals, null)); map_set(globals, intern("print") , makeFunction(prim_print, intern("print"), null, null, globals, null)); map_set(globals, intern("invoke"), makeFunction(prim_invoke, intern("invoke"), null, null, globals, null)); map_set(globals, intern("apply"), makeFunction(prim_apply, intern("apply"), null, null, globals, null)); map_set(globals, intern("clone") , makeFunction(prim_clone, intern("clone"), null, null, globals, null)); #define _DO(NAME) NAME##_symbol=intern(#NAME); DO_SYMBOLS() #undef _DO #define _DO(NAME) set(NAME##_symbol, Symbol, prototype, t_##NAME); DO_PROTOS() #undef _DO #define _DO(NAME) NAME##_proto=makeMap(); map_set(NAME##_proto, __name___symbol, NAME##_symbol); DO_PROTOS() #undef _DO while (yyparse()) { if (!yylval) break; // EOF if (opt_v) println(yylval); println(eval(globals, yylval)); } return 0; (void)yyAccept; } // Local Variables: // indent-tabs-mode: nil // End: