From 42fe9fbe10e546d98d5587f3e845c20f1ba11e87 Mon Sep 17 00:00:00 2001 From: Nathan R Date: Tue, 17 Aug 2021 13:32:55 +0200 Subject: [PATCH] removed meta.leg --- meta.leg | 2052 ------------------------------------------------------ 1 file changed, 2052 deletions(-) delete mode 100644 meta.leg diff --git a/meta.leg b/meta.leg deleted file mode 100644 index 03d18c5..0000000 --- a/meta.leg +++ /dev/null @@ -1,2052 +0,0 @@ -%{ - -/* compile: leg -o parse.c parse.leg - * cc -o parse parse.c - * - * run: echo "3+4" | ./parse - */ - -#include -#include - -#define DO_PROTOS() \ - _DO(Undefined) _DO(Integer) _DO(Float) _DO(String) _DO(Symbol) _DO(Function) _DO(Map) \ - _DO(If) _DO(While) _DO(Do) _DO(For) _DO(ForIn) _DO(Switch) _DO(Call) \ - _DO(Invoke) _DO(Func) _DO(Block) _DO(Declaration) _DO(Assign) \ - _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(Return) _DO(Break) _DO(Continue) _DO(Throw) _DO(Try) \ -// _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, - j_throw, -}; - -typedef struct jb_record -{ - sigjmp_buf jb; - oop result; - struct jb_record *next; -} jb_record; - -jb_record *jbs= NULL; - -#define jbRecPush() \ - struct jb_record jbrec; \ - jbrec.next= jbs; \ - jbs= &jbrec - -#define jbRecPop() \ - assert(jbs == &jbrec); \ - jbs= jbrec.next - -// 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) _DO(operator) _DO(map) _DO(func) \ - _DO(try) _DO(catch) _DO(finally) _DO(exception) \ - _DO(__line__) _DO(__file__) - -#define _DO(NAME) oop NAME##_symbol; -DO_SYMBOLS() -#undef _DO - -#define _DO(NAME) oop NAME##_proto; -DO_PROTOS() -#undef _DO - -int opt_g= 0; -int opt_v= 0; -oop mrAST= &_null; - -void printBacktrace(oop top); -void runtimeError(char *fmt, ...); - -typedef struct input_t -{ - oop name; - FILE *file; - struct input_t *next; - int lineNumber; -} input_t; - -input_t *inputStack= NULL; - -void inputStackPush(char *name) { - FILE *file = stdin; - if (NULL != name) { - file= fopen(name, "rb"); - if (NULL == file) { - perror(name); - exit(1); - } - } else { - name= ""; - } - input_t *input = malloc(sizeof(input_t)); - input->name= makeString(name); - input->lineNumber= 1; - input->file= file; - input->next= inputStack; - inputStack= input; - return; -} - -input_t *inputStackPop(void) { - assert(inputStack); - input_t *first= inputStack; - inputStack= first->next; - return first; -} - -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); - // set context (file and line) for runtime error msg - map_set(map, __line___symbol, makeInteger(inputStack->lineNumber)); - map_set(map, __file___symbol, inputStack->name); - 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; -// if the key is not found and it is #__proto__ then the Map prototype is returned -oop getVariable(oop object, oop key) -{ - while (!map_hasKey(object, key)) { - object = map_get(object, __proto___symbol); - if (null == object) { - if (key == __proto___symbol) - return getVariable(globals, Map_symbol); - runtimeError("Undefined: %s", printString(key)); - } - } - return map_get(object, key); -} - -oop getMember(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 == obj) { - return map_set(object, key, value); - } - } - return map_set(obj, key, value); -} - -oop getProperty(oop object, oop key) -{ - if (!map_hasKey(object, key)) { - runtimeError("Undefined: .%s", printString(key)); - } - return map_get(object, key); -} - -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 newForIn(oop name, oop expression, oop body) -{ - oop obj= newObject(ForIn_proto); - map_set(obj, name_symbol, name); - map_set(obj, expression_symbol, expression); - 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(oop value) -{ - oop integer = newObject(Integer_proto); - map_set(integer, value_symbol, value); - return integer; -} - -oop newFloat(oop value) -{ - oop obj = newObject(Float_proto); - map_set(obj, value_symbol, value); - return obj; -} - -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 newAssign(oop proto, oop lhs, oop operator, oop rhs) -{ - oop obj = newObject(proto); - map_set(obj, lhs_symbol, lhs); - map_set(obj, operator_symbol, operator); - map_set(obj, rhs_symbol, rhs); - return obj; -} - -oop newSetMap(oop proto, oop map, oop key, oop operator, oop value) -{ - oop obj = newObject(proto); - map_set(obj, map_symbol, map); - map_set(obj, key_symbol, key); - map_set(obj, operator_symbol, operator); - 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 scope, oop this, oop func, oop args, oop ast); - -oop getSyntaxId(int n, oop key) -{ - oop val = map_get(globals, key); - if (!is(Function, val)) return null; - oop fix = get(val, Function, fixed); - if (!isInteger(fix)) return null; - if (n != getInteger(fix)) return null; - return val; -} - -oop getSyntax(int n, oop func) -{ - if (map_get(func, __proto___symbol) != GetVariable_proto) return null; - oop key = map_get(func, key_symbol); - return getSyntaxId(n, key); -} - -oop newCall(oop func, oop 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 newTry(oop try, oop exception, oop catch, oop finally) -{ - oop obj = newObject(Try_proto); - map_set(obj, try_symbol, try); - map_set(obj, exception_symbol, exception); - map_set(obj, catch_symbol, catch); - map_set(obj, finally_symbol, finally); - return obj; -} - -#define YY_INPUT(buf, result, max_size) \ -{ \ - int yyc= feof(inputStack->file) ? EOF : getc(inputStack->file); \ - result= (EOF == yyc) ? 0 : (*(buf)= yyc, 1); \ -} - -#define YYSTYPE oop - -YYSTYPE yylval; - -int errorLine= 1; - -void syntaxError(char *text) -{ - fprintf(stderr, "\nSyntax error in %s near line %i:\n%s\n", get(inputStack->name, String, value), errorLine, text); - exit(1); -} - -oop eval(oop scope, oop ast); - -struct _yycontext; - -int yyparsefrom(int (*yystart)(struct _yycontext *yy)); - -%} - -meta_start = - ( META_IMPORT s:META_STRING ";" { yylval = null; inputStackPush(get(s, String, value)) } - | s:meta_stmt { yylval = s } - | !. { yylval = 0 } - | meta_error - ) - -meta_error = { errorLine= inputStack->lineNumber } - eol* < (!eol .)* eol* (!eol .)* > { syntaxError(yytext) } - -meta_stmt = s:meta_block { $$ = s } - | META_SEMICOLON { $$ = null } - | l:META_IDENT p:meta_paramList e:meta_block { $$ = newFunc(l, p, e, null) } - | META_IF META_LPAREN c:meta_exp META_RPAREN t:meta_stmt META_ELSE f:meta_stmt { $$ = newIf(c, t, f ) } - | META_IF META_LPAREN c:meta_exp META_RPAREN t:meta_stmt { $$ = newIf(c, t, null) } - | META_WHILE META_LPAREN c:meta_exp META_RPAREN s:meta_stmt { $$ = newWhile(c, s) } - | META_DO s:meta_stmt META_WHILE META_LPAREN c:meta_exp META_RPAREN { $$ = newDo(s, c) } - | META_FOR META_LPAREN i:meta_ident META_IN e:meta_exp META_RPAREN s:meta_stmt { $$ = newForIn(i, e, s) } - | META_FOR META_LPAREN i:meta_stmt c:meta_stmt u:meta_exp META_RPAREN s:meta_stmt { $$ = newFor(i, c, u, s) } - | s:meta_switch { $$ = s } - | META_RETURN e:meta_exp { $$ = newReturn(e) } - | META_RETURN { $$ = newReturn(null) } - | META_BREAK { $$ = newBreak() } - | META_CONTINUE { $$ = newContinue() } - | META_THROW e:meta_exp { $$ = newUnary(Throw_proto, e) } - | t:meta_try { $$ = t } - | e:meta_exp META_SEMICOLON { $$ = e } - -meta_block = META_LCB m:meta_makeMap - ( s:meta_stmt { map_append(m, s) } - ) * - ( s:meta_exp { map_append(m, s) } - ) ? - META_RCB { $$ = newBlock(m) } - -meta_exp = META_VAR l:meta_ident META_ASSIGN e:meta_exp { $$ = newDeclaration(l, e) } -# | META_SYNTAX l:META_IDENT p:meta_paramList q:META_IDENT e:meta_block { $$ = (map_append(p, q), newFunc(l, p, e, makeInteger(2))) } -# | META_SYNTAX p:meta_paramList q:META_IDENT e:meta_block { $$ = (map_append(p, q), newFunc(null, p, e, makeInteger(2))) } -# | META_SYNTAX l:META_IDENT p:meta_paramList e:meta_block { $$ = newFunc(l, p, e, makeInteger(1)) } -# | META_SYNTAX p:meta_paramList e:meta_block { $$ = newFunc(null, p, e, makeInteger(1)) } - | l:META_IDENT o:meta_assignOp e:meta_exp { $$ = newAssign(Assign_proto, l, o, e) } - | l:meta_postfix META_DOT i:META_IDENT o:meta_assignOp e:meta_exp { $$ = newSetMap(SetMember_proto, l, i, o, e) } - | l:meta_postfix META_LBRAC i:meta_exp META_RBRAC o:meta_assignOp e:meta_exp { $$ = newSetMap(SetIndex_proto, l, i, o, e) } - | l:meta_syntax2 a:meta_argumentList s:meta_block { $$ = (map_append(a, s), apply(globals, globals, l, a, a)) } - | c:meta_cond { $$ = c } - -meta_ident = l:META_IDENT { $$ = l } -# | META_AT n:meta_prefix { $$ = newUnary(Unquote_proto, n) } - -meta_syntax2 = < [a-zA-Z_][a-zA-Z0-9_]* > - &{ null != getSyntaxId(2, intern(yytext)) } - { $$ = getSyntaxId(2, intern(yytext)) } - -meta_try = META_TRY t:meta_stmt i:meta_null c:meta_null f:meta_null - ( META_CATCH META_LPAREN i:META_IDENT META_RPAREN c:meta_stmt ) ? - ( META_FINALLY f:meta_stmt ) ? { $$ = newTry(t, i, c, f) } - -meta_null = { $$ = null } - -meta_assignOp = META_ASSIGN { $$= null } - | META_ASSIGNADD { $$= Add_symbol } - | META_ASSIGNSUB { $$= Sub_symbol } - | META_ASSIGNMUL { $$= Mul_symbol } - | META_ASSIGNDIV { $$= Div_symbol } - | META_ASSIGNMOD { $$= Mod_symbol } - | META_ASSIGNBITOR { $$= Bitor_symbol } - | META_ASSIGNBITXOR { $$= Bitxor_symbol } - | META_ASSIGNBITAND { $$= Bitand_symbol } - | META_ASSIGNSHLEFT { $$= Shleft_symbol } - | META_ASSIGNSHRIGHT { $$= Shright_symbol } - -meta_switch = META_SWITCH META_LPAREN e:meta_exp META_RPAREN - META_LCB statements:meta_makeMap labels:meta_makeMap - ( META_CASE l:meta_exp META_COLON { map_set(labels, eval(globals, l), makeInteger(map_size(statements))) } - | META_DEFAULT META_COLON { map_set(labels, __default___symbol, makeInteger(map_size(statements))) } - | s:meta_stmt { map_append(statements, s) } - )* - META_RCB { $$= newSwitch(e, labels, statements) } - -meta_cond = c:meta_logor META_QUERY t:meta_exp META_COLON f:meta_cond { $$ = newIf(c, t, f) } - | meta_logor - -meta_logor = l:meta_logand - ( META_LOGOR r:meta_logand { l = newBinary(Logor_proto, l, r) } - )* { $$ = l } - -meta_logand = l:meta_bitor - ( META_LOGAND r:meta_bitor { l = newBinary(Logand_proto, l, r) } - )* { $$ = l } - -meta_bitor = l:meta_bitxor - ( META_BITOR r:meta_bitxor { l = newBinary(Bitor_proto, l, r) } - )* { $$ = l } - -meta_bitxor = l:meta_bitand - ( META_BITXOR r:meta_bitand { l = newBinary(Bitxor_proto, l, r) } - )* { $$ = l } - -meta_bitand = l:meta_eq - ( META_BITAND r:meta_eq { l = newBinary(Bitand_proto, l, r) } - )* { $$ = l } - -meta_eq = l:meta_ineq - ( META_EQUAL r:meta_ineq { l = newBinary(Equal_proto, l, r) } - | META_NOTEQ r:meta_ineq { l = newBinary(Noteq_proto, l, r) } - )* { $$ = l } - -meta_ineq = l:meta_shift - ( META_LESS r:meta_shift { l = newBinary(Less_proto, l, r) } - | META_LESSEQ r:meta_shift { l = newBinary(Lesseq_proto, l, r) } - | META_GREATEREQ r:meta_shift { l = newBinary(Greatereq_proto, l, r) } - | META_GREATER r:meta_shift { l = newBinary(Greater_proto, l, r) } - )* { $$ = l } - -meta_shift = l:meta_sum - ( META_SHLEFT r:meta_sum { l = newBinary(Shleft_proto, l, r) } - | META_SHRIGHT r:meta_sum { l = newBinary(Shright_proto, l, r) } - )* { $$ = l } - -meta_sum = l:meta_prod - ( META_PLUS r:meta_prod { l = newBinary(Add_proto, l, r) } - | META_MINUS r:meta_prod { l = newBinary(Sub_proto, l, r) } - )* { $$ = l } - -meta_prod = l:meta_prefix - ( META_MULTI r:meta_prefix { l = newBinary(Mul_proto, l, r) } - | META_DIVIDE r:meta_prefix { l = newBinary(Div_proto, l, r) } - | META_MODULO r:meta_prefix { l = newBinary(Mod_proto, l, r) } - )* { $$ = l } - -meta_prefix = META_PLUS n:meta_prefix { $$= n } - | META_NEGATE n:meta_prefix { $$= newUnary(Neg_proto, n) } - | META_TILDE n:meta_prefix { $$= newUnary(Com_proto, n) } - | META_PLING n:meta_prefix { $$= newUnary(Not_proto, n) } - | META_PLUSPLUS n:meta_prefix { $$= newPreIncrement(n) } - | META_MINUSMINUS n:meta_prefix { $$= newPreDecrement(n) } -# | META_BACKTICK n:meta_prefix { $$ = newUnary(Quasiquote_proto, n) } -# | META_AT n:meta_prefix { $$ = newUnary(Unquote_proto, n) } - | n:meta_postfix { $$= n } - -meta_postfix = i:meta_value ( META_DOT s:META_IDENT a:meta_argumentList { i = newInvoke(i, s, a) } - | META_DOT s:META_IDENT !meta_assignOp { i = newGetMap(GetMember_proto, i, s) } - | META_LBRAC p:meta_exp META_RBRAC !meta_assignOp { i = newGetMap(GetIndex_proto, i, p) } - | a:meta_argumentList { i = (null != getSyntax(1, i)) ? apply(globals, globals, getSyntax(1, i), a, i) : newCall(i, a) } - | META_PLUSPLUS { i = newPostIncrement(i) } - | META_MINUSMINUS { i = newPostDecrement(i) } - ) * { $$ = i } - -meta_paramList = META_LPAREN m:meta_makeMap - ( i:META_IDENT { map_append(m, i) } - ( META_COMMA i:META_IDENT { map_append(m, i) } - ) * - ) ? - META_RPAREN { $$ = m } - -meta_argumentList = META_LPAREN m:meta_makeMap - ( e:meta_exp { map_append(m, e) } - ( META_COMMA e:meta_exp { map_append(m, e) } - ) * - ) ? - META_RPAREN { $$ = m } - -meta_value = n:META_FLOAT { $$ = newFloat(n) } - | n:meta_integer { $$ = newInteger(n) } - | s:meta_string { $$ = newString(s) } - | s:meta_symbol { $$ = s } - | m:meta_map { $$ = newMap(m) } - | META_NULL { $$ = null } - | i:META_IDENT { $$ = newGetVariable(i) } - | p:meta_paramList e:meta_block { $$ = newFunc(null, p, e, null) } - | META_LPAREN ( i:meta_block | i:meta_exp ) META_RPAREN { $$ = i } - -meta_string = s:META_STRING - { $$ = s } - -META_STRING = META_DQUOTE < (!META_DQUOTE meta_char)* > META_DQUOTE { $$ = makeString(unescape(yytext)) } - -meta_char = '\\' . | . - -meta_symbol = META_HASH ( i:META_IDENT { $$ = newSymbol(i) } - | i:meta_string { $$ = newSymbol(intern(get(i, String, value))) } - ) - -meta_map = META_LCB m:meta_makeMap - ( k:meta_key META_COLON v:meta_exp { map_set(m, k, v) } - ( META_COMMA k:meta_key META_COLON v:meta_exp { map_set(m, k, v) } - ) * - ) ? - META_RCB { $$ = m } - | META_LBRAC m:meta_makeMap - ( v:meta_exp { map_append(m, v) } - ( META_COMMA v:meta_exp { map_append(m, v) } - ) * - ) ? - META_RBRAC { $$ = m } - -meta_makeMap = { $$ = makeMap() } - -meta_key = META_IDENT | meta_integer - -- = (blank | comment)* - -blank = space | eol -space = [ \t] -eol = ( "\n""\r"* - | "\r""\n"* - ) { inputStack->lineNumber++ } - -comment = "//" ( ![\n\r] . )* - | "/*" ( !"*/" (eol | .) )* "*/" - -meta_keyword = META_SWITCH | META_CASE | META_DEFAULT | META_DO | META_FOR | META_IN | META_WHILE | META_IF | META_ELSE | META_NULL | META_RETURN | META_BREAK | META_CONTINUE - | META_THROW | META_TRY | META_CATCH | META_FINALLY -# | META_SYNTAX - -META_IDENT = !meta_keyword < [a-zA-Z_][a-zA-Z0-9_]* > - { $$ = intern(yytext) } - -meta_integer = i:META_INTEGER { $$ = i } - | '-' i:meta_integer { $$ = makeInteger(-getInteger(i)) } - -META_INTEGER = '0b' < [01]+ > - { $$ = makeInteger(strtol(yytext, 0, 2)) } - | '0x' < [0-9a-fA-F]+ > - { $$ = makeInteger(strtol(yytext, 0, 16)) } - | '0' < [0-7]+ > - { $$ = makeInteger(strtol(yytext, 0, 8)) } - | < [0-9]+ > - { $$ = makeInteger(strtol(yytext, 0, 10)) } - | META_SQUOTE < (!META_SQUOTE meta_char) > META_SQUOTE - { $$ = makeInteger(unescape(yytext)[0]) } - -META_FLOAT = < [-+]* [0-9]+ '.' [0-9]* ('e'[-+]*[0-9]+)? > - { $$ = makeFloat(strtold(yytext, 0)) } - | < [-+]* [0-9]* '.' [0-9]+ ('e'[-+]*[0-9]+)? > - { $$ = makeFloat(strtold(yytext, 0)) } - | < [-+]* [0-9]+ ('e'[-+]*[0-9]+) > - { $$ = makeFloat(strtold(yytext, 0)) } - -#META_FUN = 'fun' ![a-zA-Z0-9_] - -#META_SYNTAX = 'syntax' ![a-zA-Z0-9_] - -META_VAR = 'var' ![a-zA-Z0-9_] - -META_SWITCH = 'switch' ![a-zA-Z0-9_] - -META_CASE = 'case' ![a-zA-Z0-9_] - -META_DEFAULT = 'default' ![a-zA-Z0-9_] - -META_DO = 'do' ![a-zA-Z0-9_] - -META_FOR = 'for' ![a-zA-Z0-9_] - -META_IN = 'in' ![a-zA-Z0-9_] - -META_WHILE = 'while' ![a-zA-Z0-9_] - -META_IF = 'if' ![a-zA-Z0-9_] - -META_ELSE = 'else' ![a-zA-Z0-9_] - -META_NULL = 'null' ![a-zA-Z0-9_] - -META_RETURN = 'return' ![a-zA-Z0-9_] - -META_BREAK = 'break' ![a-zA-Z0-9_] - -META_CONTINUE = 'continue' ![a-zA-Z0-9_] - -META_THROW = 'throw' ![a-zA-Z0-9_] - -META_TRY = 'try' ![a-zA-Z0-9_] - -META_CATCH = 'catch' ![a-zA-Z0-9_] - -META_FINALLY = 'finally' ![a-zA-Z0-9_] - -META_IMPORT = 'import' ![a-zA-Z0-9_] - -META_HASH = '#' - -META_LOGOR = '||' - -META_LOGAND = '&&' - -META_BITOR = '|' ![|=] - -META_BITXOR = '^' ![=] - -META_BITAND = '&' ![&=] - -META_EQUAL = '==' - -META_NOTEQ = '!=' - -META_LESS = '<' ![<=] - -META_LESSEQ = '<=' - -META_GREATEREQ = '>=' - -META_GREATER = '>' ![>=] - -META_SHLEFT = '<<' ![=] - -META_SHRIGHT = '>>' ![=] - -META_PLUS = '+' ![+=] - -META_MINUS = '-' ![-=] - -META_NEGATE = '-' ![-=0-9.] - -META_PLUSPLUS = '++' - -META_MINUSMINUS = '--' - -META_TILDE = '~' - -META_PLING = '!' ![=] - -META_MULTI = '*' ![=] - -META_DIVIDE = '/' ![/=] - -META_MODULO = '%' ![=] - -META_ASSIGN = '=' ![=] - -META_ASSIGNADD = '+=' - -META_ASSIGNSUB = '-=' - -META_ASSIGNMUL = '*=' - -META_ASSIGNDIV = '/=' - -META_ASSIGNMOD = '%=' - -META_ASSIGNBITOR = '|=' - -META_ASSIGNBITXOR = '^=' - -META_ASSIGNBITAND = '&=' - -META_ASSIGNSHLEFT = '<<=' - -META_ASSIGNSHRIGHT = '>>=' - -META_QUERY = '?' - -META_COLON = ':' - -META_SEMICOLON = ';' - -META_COMMA = ',' - -META_DOT = '.' - -#META_BACKTICK = '`' - -#META_AT = '@' - -META_LCB = '{' - -META_RCB = '}' - -META_LBRAC = '[' - -META_RBRAC = ']' - -META_LPAREN = '(' - -META_RPAREN = ')' - -META_DQUOTE = '"' -META_SQUOTE = "'" - -%% -; - - -oop map_zip(oop map, oop keys, oop values) -{ - assert(is(Map, map)); - assert(is(Map, keys)); - assert(is(Map, values)); - size_t sk= map_size(keys), sv= map_size(values); - if (sk < sv) sk= sv; - for (size_t i= 0; i < sk; ++i) { - oop key = i < sk && map_hasIntegerKey(keys, i) ? get(keys, Map, elements)[i].value : makeInteger(i); - oop value = i < sv && map_hasIntegerKey(values, i) ? get(values, Map, elements)[i].value : null; - map_set(map, key, value); - } - return map; -} - -oop clone(oop obj) -{ - switch(getType(obj)) { - case Undefined: - case Integer: - case Float: - 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; -} - -struct Call -{ - oop ast, function; -}; - -DECLARE_BUFFER(struct Call, CallArray); - -CallArray backtrace= BUFFER_INITIALISER; - -struct Call CallArray_pop(CallArray *oa) -{ assert(oa->position > 0); - return oa->contents[--oa->position]; -} - -void trace(oop ast, oop func) -{ - CallArray_append(&backtrace, (struct Call){ ast, func }); -} - -void untrace(oop ast) -{ - struct Call top= CallArray_pop(&backtrace); assert(top.ast == ast); -} - -void printLocation(oop ast) -{ - fflush(stdout); - if (!is(Map, ast)) return; - char *fileName = get (map_get(ast, __file___symbol), String, value); - int lineNumber = getInteger(map_get(ast, __line___symbol) ); - fprintf(stderr, "%s:%i", fileName, lineNumber); -} - -void printlnLocation(oop ast) -{ - fflush(stdout); - if (!is(Map, ast)) return; - printLocation(ast); - fprintf(stderr, "\n"); -} - -void printBacktrace(oop top) -{ - fflush(stdout); - printLocation(top); - while (CallArray_position(&backtrace) > 0) { - struct Call call= CallArray_pop(&backtrace); - if (is(Map, call.ast) && Call_proto == map_get(call.ast, __proto___symbol)) { - oop name= get(call.function, Function, name); - if (null != name) { - printf(" in "); - if (get(call.function, Function, primitive)) printf("primitive "); - else printf("function "); - println(get(call.function, Function, name)); - } - } - else { - printf("\n"); - } - printLocation(call.ast); - } - printf("\n"); -} - -void runtimeError(char *fmt, ...) -{ - fflush(stdout); - va_list ap; - va_start(ap, fmt); - fprintf(stderr, "\n"); - vfprintf(stderr, fmt, ap); - fprintf(stderr, "\n"); - va_end(ap); - printBacktrace(mrAST); - exit(1); -} - -#define TYPESIG(L, R) L*NTYPES+R -#define CASE(L, R) case TYPESIG(L, R) - -oop addOperation(oop lhs, oop rhs) -{ - switch (TYPESIG(getType(lhs), getType(rhs))) { - CASE(Integer, Integer): return makeInteger(getInteger(lhs) + getInteger(rhs)); - CASE(Integer, Float ): return makeFloat(getInteger(lhs) + get(rhs, Float, _value)); - CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) + getInteger(rhs)); - CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) + get(rhs, Float, _value)); - CASE(String , String ): return string_concat(lhs, rhs); - } - runtimeError("addition between two incompatible types"); - return NULL; // to prevent: control may reach end of non-void function -} - -oop subOperation(oop lhs, oop rhs) -{ - switch (TYPESIG(getType(lhs), getType(rhs))) { - CASE(Integer, Integer): return makeInteger(getInteger(lhs) - getInteger(rhs)); - CASE(Integer, Float ): return makeFloat(getInteger(lhs) - get(rhs, Float, _value)); - CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) - getInteger(rhs)); - CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) - get(rhs, Float, _value)); - } - runtimeError("substraction between two incompatible types"); - return NULL; // to prevent: control may reach end of non-void function -} - -oop mulOperation(oop lhs, oop rhs) -{ - switch (TYPESIG(getType(lhs), getType(rhs))) { - CASE(Integer, Integer): return makeInteger(getInteger(lhs) * getInteger(rhs)); - CASE(Integer, Float ): return makeFloat(getInteger(lhs) * get(rhs, Float, _value)); - CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) * getInteger(rhs)); - CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) * get(rhs, Float, _value)); - CASE(String , Integer): return string_mul(lhs, rhs); - CASE(Integer, String ): return string_mul(rhs, lhs); - } - runtimeError("multiplication between two incompatible types"); - return NULL; // to prevent: control may reach end of non-void function -} - -oop divOperation(oop lhs, oop rhs) -{ - switch (TYPESIG(getType(lhs), getType(rhs))) { - CASE(Integer, Integer): return makeInteger(getInteger(lhs) / getInteger(rhs)); - CASE(Integer, Float ): return makeFloat(getInteger(lhs) / get(rhs, Float, _value)); - CASE(Float , Integer): return makeFloat(get(lhs, Float, _value) / getInteger(rhs)); - CASE(Float , Float ): return makeFloat(get(lhs, Float, _value) / get(rhs, Float, _value)); - } - runtimeError("division between two incompatible types"); - return NULL; // to prevent: control may reach end of non-void function -} - -oop modOperation(oop lhs, oop rhs) -{ - switch (TYPESIG(getType(lhs), getType(rhs))) { - CASE(Integer, Integer): return makeInteger(getInteger(lhs) % getInteger(rhs)); - CASE(Float , Float ): return makeFloat(fmodl(get(lhs, Float, _value), get(rhs, Float, _value))); - } - runtimeError("modulo between two incompatible types"); - return NULL; // to prevent: control may reach end of non-void function -} - -#undef TYPESIG -#undef CASE - -#if 0 - -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]; - if (__proto___symbol != pair->key) { - pair->value= expandUnquotes(scope, pair->value); - } - } - return obj; -} - -#endif - -oop applyOperator(oop op, oop lhs, oop rhs) -{ - if (null != op) { assert(is(Symbol, op)); - switch (get(op, Symbol, prototype)) { - case t_Add: return addOperation(lhs, rhs); - case t_Sub: return subOperation(lhs, rhs); - case t_Mul: return mulOperation(lhs, rhs); - case t_Div: return divOperation(lhs, rhs); - case t_Mod: return modOperation(lhs, rhs); - case t_Bitor: return makeInteger(getInteger(lhs) | getInteger(rhs)); - case t_Bitxor: return makeInteger(getInteger(lhs) ^ getInteger(rhs)); - case t_Bitand: return makeInteger(getInteger(lhs) & getInteger(rhs)); - case t_Shleft: return makeInteger(getInteger(lhs) << getInteger(rhs)); - case t_Shright: return makeInteger(getInteger(lhs) >> getInteger(rhs)); - default: { - fprintf(stderr, "\nIllegal operator %i\n", get(op, Symbol, prototype)); - exit(1); - } - } - } - return rhs; -} - -oop freeScopes= 0; // pool of free scopes - -oop fixScope(oop scope) // prevent this scope and its parents from being recycled -{ assert(is(Map, scope)); - oop tmp= scope; - while (is(Map, tmp) && (0 == (tmp->Map.flags & MAP_ENCLOSED))) { - tmp->Map.flags |= MAP_ENCLOSED; - tmp= map_get(tmp, __proto___symbol); - } - return scope; -} - -oop newScope(oop parent) -{ - if (0 == freeScopes) freeScopes= makeMap(); - oop scope= freeScopes; assert(is(Map, scope)); - freeScopes= freeScopes->Map.pool; - scope->Map.size= 0; - map_set(scope, __proto___symbol, parent); - return scope; -} - -void delScope(oop scope) -{ assert(is(Map, scope)); - if (scope->Map.flags & MAP_ENCLOSED) { - printf("IGNORE %p\n", scope); - return; - } - scope->Map.pool= freeScopes; - freeScopes= scope; -} - -oop evalArgs(oop scope, oop args); - -oop apply(oop scope, oop this, oop func, oop args, oop ast) -{ - assert(is(Function, func)); - - if (NULL != get(func, Function, primitive)) { - return get(func, Function, primitive)(scope, args); - } - - oop param = get(func, Function, param); - oop localScope = newScope(get(func, Function, parentScope)); - map_zip(localScope, param, args); - map_set(localScope, this_symbol, this); - map_set(localScope, __arguments___symbol, args); - jbRecPush(); - trace(ast, func); - int jbt = sigsetjmp(jbs->jb, 0); - switch (jbt) { - case j_return: { - untrace(ast); - delScope(localScope); - oop result = jbs->result; - jbRecPop(); - return result; - } - case j_break: { - delScope(localScope); - runtimeError("break outside of a loop or switch"); - } - case j_continue: { - delScope(localScope); - runtimeError("continue outside of a loop"); - } - case j_throw: { - untrace(ast); - delScope(localScope); - oop res= jbs->result; - jbRecPop(); - jbs->result= res; - siglongjmp(jbs->jb, j_throw); - } - } - oop result= eval(localScope, get(func, Function, body)); - untrace(ast); - delScope(localScope); - jbRecPop(); - return result; -} - -oop eval(oop scope, oop ast) -{ - if (opt_v > 3) { - printf("EVAL: "); - println(ast); - } - - switch(getType(ast)) { - case Undefined: - case Integer: - case Float: - case String: - case Function: - return ast; - case Symbol: - return getVariable(scope, ast); - case Map: - break; - } - - assert(is(Map, ast)); - - mrAST= 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; - } -#if 0 - case t_Quasiquote: { - oop obj = map_get(ast, rhs_symbol); - return expandUnquotes(scope, obj); - } - case t_Unquote: { - runtimeError("@ outside of `"); - } -#endif - 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: - case j_throw: { - oop result = jbs->result; - jbRecPop(); - assert(jbs); - jbs->result = result; - siglongjmp(jbs->jb, jbt); - 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: - case j_throw: { - oop result = jbs->result; - jbRecPop(); - assert(jbs); - jbs->result = result; - siglongjmp(jbs->jb, jbt); - 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 = newScope(scope); - - jbRecPush(); - int jbt = sigsetjmp(jbs->jb, 0); - switch (jbt) { - case j_return: - case j_throw: { - delScope(localScope); - oop result = jbs->result; - jbRecPop(); - assert(jbs); - jbs->result = result; - siglongjmp(jbs->jb, jbt); - assert(0); - } - case j_break: { - delScope(localScope); - jbRecPop(); - return result; - } - case j_continue: { - goto restart_for; - } - } - - for (eval(localScope, initialise); isTrue(eval(localScope, condition)); eval(localScope, update)) { - result= eval(localScope, body); - restart_for:; - } - delScope(localScope); - jbRecPop(); - return result; - } - case t_ForIn: { - oop expr = eval(scope, map_get(ast, expression_symbol)); if (!is(Map, expr)) return null; - oop name = map_get(ast, name_symbol ) ; - oop body = map_get(ast, body_symbol ) ; - oop result = null; - oop localScope = newScope(scope); - jbRecPush(); - int jbt = sigsetjmp(jbs->jb, 0); - switch (jbt) { - case j_return: - case j_throw: { - delScope(localScope); - oop result = jbs->result; - jbRecPop(); - assert(jbs); - jbs->result = result; - siglongjmp(jbs->jb, jbt); - assert(0); - } - case j_break: { - delScope(localScope); - jbRecPop(); - return result; - } - case j_continue: { - goto restart_forin; - } - } - for (size_t i= 0; i < map_size(expr); ++i) { - map_set(localScope, name, get(expr, Map, elements)[i].key); - result= eval(localScope, body); - restart_forin:; - } - delScope(localScope); - jbRecPop(); - 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: - case j_throw: { - oop result = jbs->result; - jbRecPop(); - assert(jbs); - jbs->result = result; - siglongjmp(jbs->jb, jbt); - assert(0); - } - case j_break: { - jbRecPop(); - return null; - } - case j_continue: { - jbRecPop(); - assert(jbs); - 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); - } - jbRecPop(); - return result; - } - case t_Assign: { - oop lhs = map_get(ast, lhs_symbol); - oop op = map_get(ast, operator_symbol); - oop rhs = eval(scope, map_get(ast, rhs_symbol)); - if (null != op) rhs= applyOperator(op, getVariable(scope, lhs), rhs); - 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, fixScope(scope), fixed); - if (opt_v > 4) { - 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("\ncannot call %s\n", printString(func)); - printBacktrace(ast); - exit(1); - } - oop args = map_get(ast, args_symbol); - if (isFalse(get(func, Function, fixed))) { - args = evalArgs(scope, args); - } - return apply(scope, globals, func, args, ast); - } - case t_Invoke: { - oop this = eval(scope, map_get(ast, this_symbol)); - oop func = map_get(ast, name_symbol); assert(is(Symbol, func)); - func = getVariable(this, func); - if (!is(Function, func)) { - printf("\ncannot invoke %s\n", printString(func)); - printBacktrace(ast); - exit(1); - } - oop args = map_get(ast, args_symbol); - if (isFalse(get(func, Function, fixed))) { - args = evalArgs(scope, args); - } - return apply(scope, this, func, args, ast); - } - - case t_Return: { - assert(jbs); - jbs->result = eval(scope, map_get(ast, value_symbol)); - siglongjmp(jbs->jb, j_return); - } - case t_Break: { - assert(jbs); - siglongjmp(jbs->jb, j_break); - } - case t_Continue: { - assert(jbs); - siglongjmp(jbs->jb, j_continue); - } - case t_Throw: { - assert(jbs); - jbs->result = eval(scope, map_get(ast, rhs_symbol)); - siglongjmp(jbs->jb, j_throw); - } - case t_Try: { - oop try = map_get(ast, try_symbol); - oop exception = map_get(ast, exception_symbol); - oop catch = map_get(ast, catch_symbol); - oop finally = map_get(ast, finally_symbol); - - jbRecPush(); - int jbt = sigsetjmp(jbs->jb, 0); - if (0 == jbt) { - oop res = eval(scope, try); - jbRecPop(); - eval(scope, finally); - return res; - } - oop res= jbs->result; - jbRecPop(); - // something happend in the try block - if (j_throw == jbt) { - assert(jbs); - jbs->result= res; - - if (null == catch) { - return eval(scope, finally); - } - oop localScope= newScope(scope); - setVariable(localScope, exception, res); - - jbRecPush(); - jbt= sigsetjmp(jbs->jb, 0); - if (0 == jbt) { - eval(localScope, catch); - delScope(localScope); - jbRecPop(); - return eval(scope, finally); - } - delScope(localScope); - // something happend in the catch block - res= jbs->result; - jbRecPop(); - } - eval(scope, finally); - assert(jbs); - jbs->result= res; - siglongjmp(jbs->jb, jbt); - } - case t_Block: { - oop statements = map_get(ast, statements_symbol); - int i = 0; - oop index; - oop statement, res; - oop localScope = newScope(scope); - while ((index = makeInteger(i)), map_hasKey(statements, index)) { - statement = map_get(statements, index); - res = eval(localScope, statement); - i++; - } - delScope(localScope); - 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 getMember(map, key); - } - case t_SetMember: { - oop map = eval(scope, map_get(ast, map_symbol)); - oop key = map_get(ast, key_symbol); - oop op = map_get(ast, operator_symbol); - oop value = eval(scope, map_get(ast, value_symbol)); - if (null != op) value= applyOperator(op, getProperty(map, key), value); - if (is(Function, value) && null == get(value, Function, name)) { - set(value, Function, name, key); - } - return map_set(map, key, value); - } - case t_GetIndex: { - oop map = eval(scope, map_get(ast, map_symbol)); - oop key = eval(scope, map_get(ast, key_symbol)); - switch (getType(map)) { - case String: - if (getInteger(key) >= get(map, String, size)) { - runtimeError("GetIndex out of range on String"); - } - return makeInteger(unescape(get(map, String, value))[getInteger(key)]); - case Map: - return getVariable(map, key); - default: - runtimeError("GetIndex on non Map or String"); - } - } - case t_SetIndex: { - oop map = eval(scope, map_get(ast, map_symbol)); - oop key = eval(scope, map_get(ast, key_symbol)); - oop op = map_get(ast, operator_symbol); - oop value = eval(scope, map_get(ast, value_symbol)); - switch (getType(map)) { - case String: - if (getInteger(key) >= get(map, String, size)) { - runtimeError("SetIndex out of range on String"); - } - get(map, String, value)[getInteger(key)] = getInteger(value); - return value; - case Map: - if (null != op) value= applyOperator(op, map_get(map, key), value); - return map_set(map, key, value); - default: - runtimeError("SetIndex on non Map or String"); - } - - } - case t_Symbol: - case t_Integer: - case t_Float: - 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 RELATION(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(oopcmp(lhs, rhs) OPERATOR 0); \ - } -# 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)); \ - } -# define BINARYOP(NAME, FUNCPREFIX) \ - case t_##NAME: { \ - oop lhs = eval(scope, map_get(ast, lhs_symbol)); \ - oop rhs = eval(scope, map_get(ast, rhs_symbol)); \ - return FUNCPREFIX##Operation(lhs, rhs); \ - } - BINARY(Bitor, | ); - BINARY(Bitxor, ^ ); - BINARY(Bitand, & ); - RELATION(Equal, ==); - RELATION(Noteq, !=); - RELATION(Less, < ); - RELATION(Lesseq, <=); - RELATION(Greatereq, >=); - RELATION(Greater, > ); - BINARY(Shleft, <<); - BINARY(Shright, >>); - BINARYOP(Add, add); - BINARYOP(Mul, mul); - BINARYOP(Sub, sub); - BINARYOP(Div, div); - BINARYOP(Mod, mod); -# undef BINARYOP -# undef BINARY -# undef RELATION - 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 scope, 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 scope, 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_values(oop scope, oop params) -{ - if (map_hasIntegerKey(params, 0)) { - oop arg= get(params, Map, elements)[0].value; - if (is(Map, arg)) return map_values(arg); - } - return null; -} - -oop prim_length(oop scope, oop params) -{ - if (map_hasIntegerKey(params, 0)) { - oop arg= get(params, Map, elements)[0].value; - switch (getType(arg)) { - case String: return makeInteger(string_size(arg)); - case Symbol: return makeInteger(strlen(get(arg, Symbol, name))); - case Map: return makeInteger(map_size(arg)); - default: break; - } - } - return null; -} - -oop prim_apply(oop scope, 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(scope, globals, func, args, mrAST); -} - -oop prim_invoke(oop scope, 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; - return apply(scope, this, func, args, mrAST); -} - -oop prim_clone(oop scope, oop params) -{ - if (map_hasIntegerKey(params, 0)) return clone(get(params, Map, elements)[0].value); - return null; -} - -oop prim_print(oop scope, 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; -} - -oop AST= NULL; - -void readEvalPrint(oop scope, char *fileName) -{ - inputStackPush(fileName); - input_t *top= inputStack; - jbRecPush(); - jb_record *jtop= jbs; - int jbt= sigsetjmp(jbs->jb, 0); - - if (0 == jbt) { - while (yyparse()) { - if (opt_v > 1) printf("%s:%i: ", get(inputStack->name, String, value), inputStack->lineNumber); - if (!yylval) { - fclose(inputStack->file); - if (top == inputStack) break; - inputStackPop(); - assert(inputStack); - continue; - } // EOF - if (opt_v > 1) println(yylval); - oop res = eval(scope, yylval); - if (opt_v > 0) println(res); - assert(jbs == jtop); - } - assert(inputStack); - inputStackPop(); - jbRecPop(); - return; - } - - assert(jbs == jtop); - oop res = jbs->result; - jbRecPop(); - switch (jbt) { - case j_return: runtimeError("return outside of a function"); - case j_break: runtimeError("break outside of a loop or switch"); - case j_continue: runtimeError("continue outside of a loop"); - case j_throw: runtimeError("unhandled exception: %s", printString(res)); - } -} - -oop prim_import(oop scope, oop params) -{ - if (map_hasIntegerKey(params, 0)) { - char *file= get(get(params, Map, elements)[0].value, String, value); - if (yyctx->__pos < yyctx->__limit) { - yyctx->__limit--; - ungetc(yyctx->__buf[yyctx->__limit], inputStack->file); - } - readEvalPrint(scope, file); - } - return null; -} - -oop prim_String(oop scope, oop params) -{ - if (!map_hasIntegerKey(params, 0)) return null; - return makeString(printString(get(params, Map, elements)[0].value)); -} - -oop prim_scope(oop scope, oop params) -{ - return fixScope(scope); -} - -#include - -oop prim_microseconds(oop scope, oop params) -{ - struct rusage ru; - getrusage(RUSAGE_SELF, &ru); - return makeInteger(ru.ru_utime.tv_sec * 1000*1000 + ru.ru_utime.tv_usec); -} - -int main(int argc, char **argv) -{ -# if (USE_GC) - GC_INIT(); -# endif - - 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("values" ), makeFunction(prim_values, intern("values" ), 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)); - map_set(globals, intern("import" ), makeFunction(prim_import, intern("import" ), null, null, globals, null)); - map_set(globals, intern("microseconds"), makeFunction(prim_microseconds, intern("microseconds"), null, null, globals, null)); - map_set(globals, intern("String" ), makeFunction(prim_String , intern("String" ), null, null, globals, null)); - - map_set(globals, intern("scope"), makeFunction(prim_scope, intern("scope"), 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 - - #define _DO(NAME) map_set(globals, NAME##_symbol, NAME##_proto); - DO_PROTOS() - #undef _DO - - AST = makeMap(); - map_set(globals, intern("AST"), AST); - #define _DO(NAME) map_set(AST, NAME##_symbol, NAME##_proto); - DO_PROTOS() - #undef _DO - - fixScope(globals); - - int repled = 0; - while (argc-- > 1) { - ++argv; - if (!strcmp(*argv, "-g")) ++opt_g; - else if (!strcmp(*argv, "-v")) ++opt_v; - else if (!strcmp(*argv, "-")) { - readEvalPrint(globals, NULL); - repled= 1; - } - else { - readEvalPrint(globals, *argv); - repled= 1; - } - } - if (!repled) { - readEvalPrint(globals, NULL); - } - - if (opt_g) { - if (nalloc < 1024) printf("[GC: %lli bytes allocated]\n", nalloc ); - else if (nalloc < 1024*1024) printf("[GC: %lli kB allocated]\n", nalloc / 1024 ); - else if (nalloc < 1024*1024*1024) printf("[GC: %.2f MB allocated]\n", (double)nalloc / ( 1024*1024)); - else printf("[GC: %.2f GB allocated]\n", (double)nalloc / (1024*1024*1024)); - } - - return 0; - - (void)yyAccept; -} - -// Local Variables: -// indent-tabs-mode: nil -// End: