diff --git a/object.c b/object.c index 0518095..f2c0319 100644 --- a/object.c +++ b/object.c @@ -5,21 +5,33 @@ #include #define USE_TAG 1 - #define USE_GC 1 #if (USE_GC) # include #endif +typedef long long int_t; + +#define FMT_I "%lli" + +void *memcheck(void *ptr) +{ + if (NULL == ptr) { + fprintf(stderr, "Error: out of memory\n"); + exit(EX_OSERR); // this is as close as we have for 'resource unavailable' + } + return ptr; +} + void *xmalloc(size_t n) { #if (USE_GC) void *mem= GC_malloc(n); + assert(mem); #else - void *mem= calloc(1, n); + void *mem= memcheck(calloc(1, n)); #endif - assert(mem); return mem; } @@ -27,10 +39,10 @@ void *xrealloc(void *p, size_t n) { #if (USE_GC) void *mem= GC_realloc(p, n); + assert(mem); #else - void *mem= realloc(p, n); + void *mem= memcheck(realloc(p, n)); #endif - assert(mem); return mem; } @@ -39,11 +51,11 @@ char *xstrdup(char *s) #if (USE_GC) size_t len= strlen(s); char *mem= GC_malloc_atomic(len + 1); + assert(mem); memcpy(mem, s, len + 1); #else - char *mem= strdup(s); + char *mem= memcheck(strdup(s)); #endif - assert(mem); return mem; } @@ -69,7 +81,7 @@ struct Undefined { struct Integer { type_t type; - int _value; + int_t _value; }; struct String { @@ -126,10 +138,17 @@ const oop null = &_null; int is(type_t type, oop obj); +#if (USE_TAG) +int isTag(oop obj) +{ + return ((intptr_t)obj & 1); +} +#endif + int isInteger(oop obj) { #if (USE_TAG) - return (intptr_t)obj & 1; + return ((intptr_t)obj & 1) || is(Integer, obj); #else return is(Integer, obj); #endif @@ -164,15 +183,6 @@ oop _checkType(oop ptr, type_t type, char *file, int line) #define get(PTR, TYPE, FIELD) (_checkType(PTR, TYPE, __FILE__, __LINE__)->TYPE.FIELD) #define set(PTR, TYPE, FIELD, VALUE) (_checkType(PTR, TYPE, __FILE__, __LINE__)->TYPE.FIELD = VALUE) -void *memcheck(void *ptr) -{ - if (NULL == ptr) { - fprintf(stderr, "Error: out of memory\n"); - exit(EX_OSERR); // this is as close as we have for 'resource unavailable' - } - return ptr; -} - #include "buffer.h" DECLARE_STRING_BUFFER(char, StringBuffer); @@ -180,106 +190,93 @@ void print(oop ast); void println(oop ast); void printOn(StringBuffer *buf, oop obj, int indent); -int getInteger(oop obj) +int_t getInteger(oop obj) { +#if (USE_TAG) + if (isTag(obj)) return (intptr_t)obj >> 1; +#endif if (!isInteger(obj)) { - fprintf(stderr, "\nNon-integer in arithmetic expression\n"); + fprintf(stderr, "\nNon-integer in arithmetic expression\n"); exit(1); } -#if (USE_TAG) - return (intptr_t)obj >> 1; -#else return get(obj, Integer, _value); -#endif } -oop makeInteger(int value) +#if (USE_TAG) +int isIntegerValue(int_t value) +{ + return (((intptr_t)value << 1) >> 1) == value; +// return -32 <= value && value < 32; +} +#endif + +oop makeInteger(int_t value) { #if (USE_TAG) - return (oop) (((intptr_t)value << 1) | 1); -#else - oop newInt = memcheck(malloc(sizeof(union object))); + if (isIntegerValue(value)) return (oop)(((intptr_t)value << 1) | 1); +#endif + oop newInt = malloc(sizeof(union object)); newInt->type = Integer; newInt->Integer._value = value; return newInt; -#endif } -// value will be copied oop makeString(char *value) { - oop newString = memcheck(malloc(sizeof(union object))); + oop newString = malloc(sizeof(union object)); newString->type = String; - newString->String.value = memcheck(strdup(value)); + newString->String.value = strdup(value); newString->String.size = strlen(value); return newString; } -// value will be used directly -oop makeStringFrom(char *value, size_t l) -{ - oop newString = memcheck(malloc(sizeof(union object))); - newString->type = String; - newString->String.value = value; - newString->String.size = l; - return newString; -} - size_t string_size(oop s) { return get(s, String, size); } -oop string_slice(oop str, ssize_t start, ssize_t stop) { - assert(is(String, str)); - size_t len = string_size(str); - if (start < 0) start= start + len; - if (stop < 0) stop= stop + len; - if (start < 0 || start > len) return NULL; - if (stop < 0 || stop > len) return NULL; - if (start > stop) return NULL; - - size_t cpylen = stop - start; - char *slice= memcheck(malloc(sizeof(char) * (cpylen + 1))); - memcpy(slice, get(str, String, value) + start, cpylen); - slice[cpylen]= '\0'; - return makeStringFrom(slice, cpylen); -} - oop string_concat(oop str1, oop str2) { size_t len = string_size(str1) + string_size(str2); - char *concat = memcheck(malloc(sizeof(char) * len + 1)); + char *concat = malloc(sizeof(char) * len + 1); memcpy(concat, get(str1, String, value), string_size(str1)); memcpy(concat + string_size(str1), get(str2, String, value), string_size(str2)); concat[len]= '\0'; - return makeStringFrom(concat, len); + oop newString = malloc(sizeof(union object)); + newString->type = String; + newString->String.value = concat; + newString->String.size = len; + return newString; } oop string_mul(oop str, oop factor) { ssize_t len = string_size(str) * getInteger(factor); if (len < 0) len = 0; - char *concat = memcheck(malloc(sizeof(char) * len + 1)); + char *concat = malloc(sizeof(char) * len + 1); for (int i=0; i < getInteger(factor); ++i) { memcpy(concat + (i * string_size(str)), get(str, String, value), string_size(str)); } concat[len]= '\0'; - return makeStringFrom(concat, len); + oop newString = malloc(sizeof(union object)); + newString->type = String; + newString->String.value = concat; + newString->String.size = len; + return newString; } oop makeSymbol(char *name) { - oop newSymb = memcheck(malloc(sizeof(union object))); + oop newSymb = malloc(sizeof(union object)); newSymb->type = Symbol; - newSymb->Symbol.name = memcheck(strdup(name)); + newSymb->Symbol.name = strdup(name); newSymb->Symbol.prototype = 0; return newSymb; } oop makeFunction(primitive_t primitive, oop name, oop param, oop body, oop parentScope, oop fixed) { - oop newFunc = memcheck(malloc(sizeof(union object))); + oop newFunc = malloc(sizeof(union object)); newFunc->type = Function; newFunc->Function.primitive = primitive; newFunc->Function.name = name; @@ -292,7 +289,7 @@ oop makeFunction(primitive_t primitive, oop name, oop param, oop body, oop paren oop makeMap() { - oop newMap = memcheck(malloc(sizeof(union object))); + oop newMap = malloc(sizeof(union object)); newMap->type = Map; return newMap; } @@ -386,7 +383,7 @@ oop map_insert(oop map, oop key, oop value, size_t pos) // check capacity and expand if needed if (map_size(map) >= get(map, Map, capacity)) { size_t newCapacity = get(map, Map, capacity) + MAP_CHUNK_SIZE; - set(map, Map, elements, memcheck(realloc(get(map, Map, elements), sizeof(struct Pair) * newCapacity))); + set(map, Map, elements, realloc(get(map, Map, elements), sizeof(struct Pair) * newCapacity)); set(map, Map, capacity, newCapacity); } @@ -478,26 +475,6 @@ oop map_values(oop map) return values; } -oop map_slice(oop map, ssize_t start, ssize_t stop) { - assert(is(Map, map)); - size_t len = map_size(map); - if (start < 0) start= start + len; - if (stop < 0) stop= stop + len; - if (start < 0 || start > len) return NULL; - if (stop < 0 || stop > len) return NULL; - if (start > stop) return NULL; - - oop slice= makeMap(); - if (start < stop) { - if (!map_hasIntegerKey(map, start )) return NULL; - if (!map_hasIntegerKey(map, stop - 1)) return NULL; - for (size_t i= start; i < stop; ++i) { - map_append(slice, get(map, Map, elements)[i].value); - } - } - return slice; -} - DECLARE_BUFFER(oop, OopStack); OopStack printing = BUFFER_INITIALISER; @@ -573,8 +550,8 @@ void printOn(StringBuffer *buf, oop obj, int indent) return; } case Integer: { - char tmp[32]; - int length = snprintf(tmp, sizeof(tmp), "%i", getInteger(obj)); + char tmp[40]; + int length = snprintf(tmp, sizeof(tmp), FMT_I, getInteger(obj)); StringBuffer_appendAll(buf, tmp, length); return; } @@ -596,7 +573,7 @@ void printOn(StringBuffer *buf, oop obj, int indent) printOn(buf, get(obj, Function, name), indent); StringBuffer_append(buf, '('); printOn(buf, get(obj, Function, param), indent + 1); - if (get(obj, Function, param) != null) { + if (is(Map, get(obj, Function, param)) && map_size(get(obj, Function, param)) > 0) { StringBuffer_append(buf, '\n'); indentOn(buf, indent); } diff --git a/parse.leg b/parse.leg index 1b66bac..abb4624 100644 --- a/parse.leg +++ b/parse.leg @@ -6,19 +6,19 @@ * 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(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(Slice) \ - _DO(Return) _DO(Break) _DO(Continue) _DO(Throw) _DO(Try) \ +#define DO_PROTOS() \ + _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(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(Return) _DO(Break) _DO(Continue) _DO(Throw) _DO(Try) \ _DO(Quasiquote) _DO(Unquote) typedef enum { @@ -51,7 +51,7 @@ typedef struct jb_record jb_record *jbs= NULL; jb_record *jbRecPush() { - jb_record *newJbRec = memcheck(malloc(sizeof(jb_record))); + jb_record *newJbRec = malloc(sizeof(jb_record)); newJbRec->result = null; newJbRec->next = jbs; jbs = newJbRec; @@ -75,8 +75,7 @@ oop globals= 0; _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__) \ - _DO(start) _DO(stop) + _DO(__line__) _DO(__file__) #define _DO(NAME) oop NAME##_symbol; DO_SYMBOLS() @@ -89,6 +88,8 @@ DO_PROTOS() int opt_v= 0; oop mrAST= &_null; +void printBacktrace(oop top); + typedef struct input_t { oop name; @@ -110,7 +111,7 @@ void inputStackPush(char *name) { } else { name= ""; } - input_t *input = memcheck(malloc(sizeof(input_t))); + input_t *input = malloc(sizeof(input_t)); input->name= makeString(name); input->lineNumber= 1; input->file= file; @@ -176,9 +177,6 @@ oop getVariable(oop object, oop key) while (!map_hasKey(object, key)) { object = map_get(object, __proto___symbol); if (null == object) { - printf("\nUndefined: "); - println(key); - exit(1); return null; } } @@ -203,6 +201,7 @@ oop getMember(oop object, oop key) if (!map_hasKey(object, key)) { printf("\nUndefined: ."); println(key); + printBacktrace(mrAST); exit(1); return null; } @@ -259,6 +258,15 @@ oop newFor(oop init, oop cond, oop step, oop 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); @@ -486,7 +494,7 @@ oop newFunc(oop name, oop param, oop body, oop fixed) return func; } -oop apply(oop scope, oop func, oop args); +oop apply(oop scope, oop this, oop func, oop args, oop ast); oop getSyntaxId(int n, oop key) { @@ -548,15 +556,6 @@ oop newContinue(void) return obj; } -oop newSlice(oop value, oop start, oop stop) -{ - oop obj= newObject(Slice_proto); - map_set(obj, value_symbol, value); - map_set(obj, start_symbol, start); - map_set(obj, stop_symbol, stop); - return obj; -} - oop newTry(oop try, oop exception, oop catch, oop finally) { oop obj = newObject(Try_proto); @@ -569,10 +568,10 @@ oop newTry(oop try, oop exception, oop catch, oop finally) oop fold(oop ast); -#define YY_INPUT(buf, result, max_size) \ -{ \ -int yyc= getc(inputStack->file); \ -result= (EOF == yyc) ? 0 : (*(buf)= yyc, 1); \ +#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 @@ -596,6 +595,7 @@ int yyparsefrom(int (*yystart)(struct _yycontext *yy)); %} start = - ( IMPORT s:STRING { yylval = null; inputStackPush(get(s, String, value)) } + | e:exp ';' { yylval = e } | e:stmt { yylval = e } | !. { yylval = 0 } | error @@ -608,7 +608,7 @@ stmt = e:exp SEMICOLON* { $$ = e } | s:block { $$ = s } block = LCB m:makeMap - ( s:stmt { map_append(m, s) } + ( s:stmt { map_append(m, s) } ) * RCB { $$ = newBlock(m) } @@ -624,6 +624,7 @@ exp = VAR l:ident ASSIGN e:exp { $$ = newDeclarati | 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:ident IN e:exp RPAREN s:stmt { $$ = newForIn(i, e, s) } | FOR LPAREN i:stmt c:stmt u:exp RPAREN s:stmt { $$ = newFor(i, c, u, s) } | s:switch { $$ = s } | RETURN e:exp { $$ = newReturn(e) } @@ -635,7 +636,7 @@ exp = VAR l:ident ASSIGN e:exp { $$ = newDeclarati | l:IDENT o:assignOp e:exp { $$ = newAssign(Assign_proto, l, o, e) } | l:postfix DOT i:IDENT o:assignOp e:exp { $$ = newSetMap(SetMember_proto, l, i, o, e) } | l:postfix LBRAC i:exp RBRAC o:assignOp e:exp { $$ = newSetMap(SetIndex_proto, l, i, o, e) } - | l:syntax2 a:argumentList s:block { $$ = (map_append(a, s), apply(globals, l, a)) } + | l:syntax2 a:argumentList s:block { $$ = (map_append(a, s), apply(globals, globals, l, a, a)) } | c:cond { $$ = c } ident = l:IDENT { $$ = l } @@ -674,24 +675,24 @@ cond = c:logor QUERY t:exp COLON f:cond { $$ = newIf(c, t, | logor logor = l:logand - ( LOGOR r:logand { l = newBinary(Logor_proto, l, r) } - )* { $$ = l } + ( LOGOR r:logand { l = newBinary(Logor_proto, l, r) } + )* { $$ = l } logand = l:bitor - ( LOGAND r:bitor { l = newBinary(Logand_proto, l, r) } - )* { $$ = l } + ( LOGAND r:bitor { l = newBinary(Logand_proto, l, r) } + )* { $$ = l } bitor = l:bitxor - ( BITOR r:bitxor { l = newBinary(Bitor_proto, l, r) } - )* { $$ = l } + ( BITOR r:bitxor { l = newBinary(Bitor_proto, l, r) } + )* { $$ = l } bitxor = l:bitand - ( BITXOR r:bitand { l = newBinary(Bitxor_proto, l, r) } - )* { $$ = l } + ( BITXOR r:bitand { l = newBinary(Bitxor_proto, l, r) } + )* { $$ = l } bitand = l:eq - ( BITAND r:eq { l = newBinary(Bitand_proto, l, r) } - )* { $$ = l } + ( BITAND r:eq { l = newBinary(Bitand_proto, l, r) } + )* { $$ = l } eq = l:ineq ( EQUAL r:ineq { l = newBinary(Equal_proto, l, r) } @@ -711,8 +712,8 @@ shift = l:sum )* { $$ = l } sum = l:prod - ( PLUS r:prod { l = newBinary(Add_proto, l, r) } - | MINUS r:prod { l = newBinary(Sub_proto, l, r) } + ( PLUS r:prod { l = newBinary(Add_proto, l, r) } + | MINUS r:prod { l = newBinary(Sub_proto, l, r) } )* { $$ = l } prod = l:prefix @@ -733,12 +734,8 @@ prefix = PLUS n:prefix { $$= 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 e1:exp COLON e2:exp RBRAC !assignOp { i = newSlice(i, e1, e2) } - | LBRAC e1:exp COLON RBRAC !assignOp { i = newSlice(i, e1, null) } - | LBRAC COLON e2:exp RBRAC !assignOp { i = newSlice(i, null, e2) } - | LBRAC COLON RBRAC !assignOp { i = newSlice(i, null, null) } | LBRAC p:exp RBRAC !assignOp { i = newGetMap(GetIndex_proto, i, p) } - | a:argumentList { i = (null != getSyntax(1, i)) ? apply(globals, getSyntax(1, i), a) : newCall(i, a) } + | a:argumentList { i = (null != getSyntax(1, i)) ? apply(globals, globals, getSyntax(1, i), a, i) : newCall(i, a) } | PLUSPLUS { i = newPostIncrement(i) } | MINUSMINUS { i = newPostDecrement(i) } ) * { $$ = i } @@ -764,6 +761,7 @@ value = n:NUMBER { $$ = newInteger(n) } | NULL { $$ = null } | i:IDENT { $$ = newGetVariable(i) } | LPAREN i:stmt RPAREN { $$ = i } + | b:block { $$ = b } string = s:STRING - { $$ = s } @@ -800,10 +798,10 @@ eol = ( "\n""\r"* | "\r""\n"* ) { inputStack->lineNumber++ } -comment = "//" ( ![\n\r] . )* - | "/*" ( !"*/" . )* "*/" +comment = "//" ( ![\n\r] . )* + | "/*" ( !"*/" (eol | .) )* "*/" -keyword = FUN | SYNTAX | VAR | SWITCH | CASE | DEFAULT | DO | FOR | WHILE | IF | ELSE | NULL | RETURN | BREAK | CONTINUE +keyword = FUN | SYNTAX | VAR | SWITCH | CASE | DEFAULT | DO | FOR | IN | WHILE | IF | ELSE | NULL | RETURN | BREAK | CONTINUE | THROW | TRY | CATCH | FINALLY IDENT = !keyword < [a-zA-Z_][a-zA-Z0-9_]* > - { $$ = intern(yytext) } @@ -822,6 +820,7 @@ CASE = 'case' ![a-zA-Z0-9_] - DEFAULT = 'default' ![a-zA-Z0-9_] - DO = 'do' ![a-zA-Z0-9_] - FOR = 'for' ![a-zA-Z0-9_] - +IN = 'in' ![a-zA-Z0-9_] - WHILE = 'while' ![a-zA-Z0-9_] - IF = 'if' ![a-zA-Z0-9_] - ELSE = 'else' ![a-zA-Z0-9_] - @@ -946,7 +945,7 @@ void trace(oop ast, oop func) void untrace(oop ast) { - struct Call top= CallArray_pop(&backtrace); assert(top.ast == ast); + struct Call top= CallArray_pop(&backtrace); assert(top.ast == ast); } void printLocation(oop ast) @@ -1067,30 +1066,37 @@ oop fold(oop ast) if (isFalse(fold(rhs))) return makeInteger(0); return makeInteger(1); } -# define BINARY(NAME, OPERATOR) \ +# define RELATION(NAME, OPERATOR) \ + case t_##NAME: { \ + oop lhs= fold(map_get(ast, lhs_symbol)); \ + oop rhs= fold(map_get(ast, rhs_symbol)); \ + return makeInteger(oopcmp(lhs, rhs) OPERATOR 0); \ + } +# 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) \ + BINARY(Bitor, | ); + BINARY(Bitxor, ^ ); + BINARY(Bitand, & ); + RELATION(Equal, ==); + RELATION(Noteq, !=); + RELATION(Less, < ); + RELATION(Lesseq, <=); + RELATION(Greatereq, >=); + RELATION(Greater, > ); + BINARY(Shleft, <<); + BINARY(Shright, >>); + BINARY(Add, + ); + BINARY(Sub, - ); + BINARY(Mul, * ); + BINARY(Div, / ); + BINARY(Mod, % ); +# undef BINARY +# undef RELATION +# define UNARY(NAME, OPERATOR) \ case t_##NAME: { \ oop rhs = fold(map_get(ast, rhs_symbol)); \ return makeInteger(OPERATOR getInteger(rhs)); \ @@ -1098,7 +1104,7 @@ oop fold(oop ast) UNARY(Not, !); UNARY(Neg, -); UNARY(Com, ~); -# undef UNARY +# undef UNARY default: break; } @@ -1113,28 +1119,71 @@ oop fold(oop ast) oop applyOperator(oop ast, oop op, oop lhs, oop rhs) { if (null != op) { assert(is(Symbol, op)); - switch (get(op, Symbol, prototype)) { - case t_Add: return addOperation(ast, lhs, rhs); - case t_Sub: return makeInteger(getInteger(lhs) - getInteger(rhs)); - case t_Mul: return mulOperation(ast, lhs, rhs); - case t_Div: return makeInteger(getInteger(lhs) / getInteger(rhs)); - case t_Mod: return makeInteger(getInteger(lhs) % getInteger(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); + switch (get(op, Symbol, prototype)) { + case t_Add: return addOperation(ast, lhs, rhs); + case t_Sub: return makeInteger(getInteger(lhs) - getInteger(rhs)); + case t_Mul: return mulOperation(ast, lhs, rhs); + case t_Div: return makeInteger(getInteger(lhs) / getInteger(rhs)); + case t_Mod: return makeInteger(getInteger(lhs) % getInteger(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 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 = 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(); + trace(ast, func); + int jbt = sigsetjmp(jbs->jb, 0); + switch (jbt) { + case j_return: { + untrace(ast); + oop result = jbs->result; + jbRecPop(); + return result; + } + case j_break: { + runtimeError("break outside of a loop or switch"); + } + case j_continue: { + runtimeError("continue outside of a loop"); + } + case j_throw: { + untrace(ast); + oop res= jbs->result; + jbRecPop(); + jbs->result= res; + siglongjmp(jbs->jb, j_throw); + } + } + oop result= eval(localScope, get(func, Function, body)); + untrace(ast); + jbRecPop(); + return result; +} + oop eval(oop scope, oop ast) { if (opt_v > 3) { @@ -1280,7 +1329,7 @@ oop eval(oop scope, oop ast) } case j_break: { jbRecPop(); - return null; + return result; } case j_continue: { goto restart_for; @@ -1294,6 +1343,40 @@ oop eval(oop scope, oop ast) 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 = newObject(scope); + 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 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:; + } + jbRecPop(); + return result; + } case t_Switch: { oop expression = map_get(ast, expression_symbol ); oop labels = map_get(ast, labels_symbol ); @@ -1369,107 +1452,26 @@ oop eval(oop scope, oop ast) printBacktrace(ast); 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 > 4) { - printf("parentScope: "); - println(get(func, Function, parentScope)); - printf("localScope: "); - println(localScope); - } - - jbRecPush(); - trace(ast, func); - int jbt = sigsetjmp(jbs->jb, 0); - switch (jbt) { - case j_return: { - untrace(ast); - oop result = jbs->result; - jbRecPop(); - return result; - } - case j_break: { - runtimeError("break outside of a loop"); - } - case j_continue: { - runtimeError("continue outside of a loop"); - } - case j_throw: { - untrace(ast); - oop res= jbs->result; - jbRecPop(); - jbs->result= res; - siglongjmp(jbs->jb, j_throw); - } - } - - oop result = eval(localScope, get(func, Function, body)); - untrace(ast); - jbRecPop(); - return result; - } - return get(func, Function, primitive)(scope, args); + return apply(scope, globals, func, args, ast); } 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)); + 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 = evalArgs(scope, map_get(ast, args_symbol)); - if (NULL != get(func, Function, primitive)) { - return get(func, Function, primitive)(scope, 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 > 4) { - 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: { - runtimeError("break outside of a loop"); - } - case j_continue: { - runtimeError("continue outside of a loop"); - } - case j_throw: { - oop res= jbs->result; - jbRecPop(); - jbs->result= res; - siglongjmp(jbs->jb, j_throw); - } + oop args = map_get(ast, args_symbol); + if (isFalse(get(func, Function, fixed))) { + args = evalArgs(scope, args); } - - oop result = eval(localScope, get(func, Function, body)); - jbRecPop(); - return result; + return apply(scope, this, func, args, ast); } case t_Return: { @@ -1570,23 +1572,11 @@ oop eval(oop scope, oop ast) oop key = eval(scope, map_get(ast, key_symbol)); switch (getType(map)) { case String: - if (!isInteger(key)) { - runtimeError("non-integer index"); - } - ssize_t i= getInteger(key); - size_t len= string_size(map); - if (i < 0) i+= len; - if (i < 0 || i >= len) { - runtimeError("GetIndex out of bounds on String"); + if (getInteger(key) >= get(map, String, size)) { + runtimeError("GetIndex out of range on String"); } - return makeInteger(get(map, String, value)[i]); + return makeInteger(unescape(get(map, String, value))[getInteger(key)]); case Map: - if (isInteger(key) && getInteger(key) < 0) { - size_t size= map_size(map); - if (size > 0 && map_hasIntegerKey(map, size - 1)) { - key= makeInteger(getInteger(key) + size); - } - } return map_get(map, key); default: runtimeError("GetIndex on non Map or String"); @@ -1600,7 +1590,7 @@ oop eval(oop scope, oop ast) switch (getType(map)) { case String: if (getInteger(key) >= get(map, String, size)) { - runtimeError("SetIndex out of bounds on String"); + runtimeError("SetIndex out of range on String"); } get(map, String, value)[getInteger(key)] = getInteger(value); return value; @@ -1612,35 +1602,6 @@ oop eval(oop scope, oop ast) } } - case t_Slice: { - oop pre= eval(scope, map_get(ast, value_symbol)); - oop start= eval(scope, map_get(ast, start_symbol)); - oop stop= eval(scope, map_get(ast, stop_symbol)); - ssize_t first= start == null ? 0 : getInteger(start); - - if (start == null) { - start= makeInteger(0); - } - switch (getType(pre)) { - case String: { - ssize_t last= stop == null ? string_size(pre) : getInteger(stop); - oop res= string_slice(pre, first, last); - if (NULL == res) { - runtimeError("index out of bounds"); - } - return res; - } - case Map: { - ssize_t last= stop == null ? map_size(pre) : getInteger(stop); - oop res= map_slice(pre, first, last); - if (NULL == res) { - runtimeError("index out of bounds"); - } - return res; - } - } - runtimeError("slicing a non-String or non-Map"); - } case t_Symbol: case t_Integer: case t_String: { @@ -1660,31 +1621,29 @@ oop eval(oop scope, oop ast) 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)); \ } - BINARY(Bitor, | ); - BINARY(Bitxor, ^ ); - BINARY(Bitand, & ); - case t_Equal: { - oop lhs = eval(scope, map_get(ast, lhs_symbol)); - oop rhs = eval(scope, map_get(ast, rhs_symbol)); - return makeInteger(0 == oopcmp(lhs, rhs)); - } - case t_Noteq: { - oop lhs = eval(scope, map_get(ast, lhs_symbol)); - oop rhs = eval(scope, map_get(ast, rhs_symbol)); - return makeInteger(0 != oopcmp(lhs, rhs)); - } - BINARY(Less, < ); - BINARY(Lesseq, <=); - BINARY(Greatereq, >=); - BINARY(Greater, > ); - BINARY(Shleft, <<); - BINARY(Shright, >>); + BINARY(Bitor, | ); + BINARY(Bitxor, ^ ); + BINARY(Bitand, & ); + RELATION(Equal, ==); + RELATION(Noteq, !=); + RELATION(Less, < ); + RELATION(Lesseq, <=); + RELATION(Greatereq, >=); + RELATION(Greater, > ); + BINARY(Shleft, <<); + BINARY(Shright, >>); // BINARY(Add, + ); case t_Add: { oop lhs = eval(scope, map_get(ast, lhs_symbol)); @@ -1701,6 +1660,7 @@ oop eval(oop scope, oop ast) BINARY(Div, / ); BINARY(Mod, % ); # undef BINARY +# undef RELATION case t_Not: { oop rhs = eval(scope, map_get(ast, rhs_symbol)); return makeInteger(isFalse(rhs)); @@ -1848,94 +1808,18 @@ oop prim_length(oop scope, oop params) 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; - if (!is(Function, func)) { - printf("\ncannot invoke %s\n", printString(func)); - printBacktrace(mrAST); - exit(1); - } - if (NULL != get(func, Function, primitive)) { - return get(func, Function, primitive)(scope, 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: { - runtimeError("break outside of a loop or switch"); - } - case j_continue: { - runtimeError("continue oustide of a loop"); - } - case j_throw: { - oop res= jbs->result; - jbRecPop(); - jbs->result= res; - siglongjmp(jbs->jb, j_throw); - } - } - oop result= eval(localScope, get(func, Function, body)); - jbRecPop(); - return result; -} - -oop apply(oop scope, oop func, oop args) -{ - if (!is(Function, func)) { - printf("\ncannot apply %s\n", printString(func)); - printBacktrace(mrAST); - exit(1); - } - if (NULL != get(func, Function, primitive)) { - return get(func, Function, primitive)(scope, 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: { - runtimeError("break outside of a loop or switch"); - } - case j_continue: { - runtimeError("continue outside of a loop"); - } - case j_throw: { - oop res= jbs->result; - jbRecPop(); - jbs->result= res; - siglongjmp(jbs->jb, j_throw); - } - } - oop result= eval(localScope, get(func, Function, body)); - jbRecPop(); - return result; -} - -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, func, args); + return apply(scope, this, func, args, mrAST); } oop prim_clone(oop scope, oop params) @@ -2033,11 +1917,11 @@ oop prim_scope(oop scope, oop params) #include -oop prim_millis(oop scope, oop params) +oop prim_microseconds(oop scope, oop params) { struct rusage ru; getrusage(RUSAGE_SELF, &ru); - return makeInteger(ru.ru_utime.tv_sec * 1000 + ru.ru_utime.tv_usec / 1000); + return makeInteger(ru.ru_utime.tv_sec * 1000*1000 + ru.ru_utime.tv_usec); } int main(int argc, char **argv) @@ -2049,16 +1933,16 @@ int main(int argc, char **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("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("millis") , makeFunction(prim_millis, intern("millis"), null, null, globals, null)); + 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("scope"), makeFunction(prim_scope, intern("scope"), null, null, globals, null)); diff --git a/test-error.txt b/test-error.txt new file mode 100644 index 0000000..d3923af --- /dev/null +++ b/test-error.txt @@ -0,0 +1,5 @@ +fun fib(n) { + if (n < 2) "1" else 1 + fib(n-1) + fib(n-2); +} + +println(fib(15)) diff --git a/test-namespace.txt b/test-namespace.txt new file mode 100644 index 0000000..9208ac3 --- /dev/null +++ b/test-namespace.txt @@ -0,0 +1,30 @@ +syntax class (name) body { + `{ __name__ = @name; + @body; + scope() + } +} + +var ns = { + __name__ = #"testing"; + var counter = 0; + fun inc () { ns.counter += 1 }; + fun dec () { ns.counter -= 1 }; + scope() +}; + +println(ns.counter); + +ns.inc(); println(ns.counter); +ns.inc(); println(ns.counter); +ns.inc(); println(ns.counter); + +ns.dec(); println(ns.counter); +ns.dec(); println(ns.counter); +ns.dec(); println(ns.counter); + +var obj = { __proto__ = ns; scope() }; + +obj.inc(); + +println(obj.counter); diff --git a/test-object.txt b/test-object.txt index dcb59e2..7b87da3 100644 --- a/test-object.txt +++ b/test-object.txt @@ -1,25 +1,25 @@ var Object = { __name__: #"Object" }; -print("Object is ", Object); +println("Object is ", Object); var Point = { __name__: #"Point", __proto__ : Object }; -print("Point is ", Point); +println("Point is ", Point); Object.new = fun () { - print("ARGS are ", __arguments__); + println("ARGS are ", __arguments__); var obj= { __proto__ : this }; var init= this.init; - print("INIT is ", init); + println("INIT is ", init); init && invoke(obj, init, __arguments__); obj; }; -print("Object.new is ", Object.new); +println("Object.new is ", Object.new); -print("Point.new is ", Point.new); +println("Point.new is ", Point.new); -print("Object.new() is ", Object.new()); +println("Object.new() is ", Object.new()); Point.init = fun (x, y) { this.x = x; @@ -28,7 +28,7 @@ Point.init = fun (x, y) { var p = Point.new(3, 4); -print("Point.new(3, 4) is ", p); +println("Point.new(3, 4) is ", p); @@ -36,9 +36,9 @@ Object.clone = fun () { clone(this) } var q = p.clone(); -print("clone is ", q); +println("clone is ", q); -Object.println = fun () { this.print(); print('\n'); this; } +Object.println = fun () { this.print(); print("\n"); this; } Object.print = fun () { var proto= this.__proto__; @@ -69,7 +69,7 @@ fun println() { } fun makeAst() { - print("Making an AST!") + println("Making an AST!") return t } @@ -87,10 +87,26 @@ syntax until(c, b) { return `(while (!@c) @b) } -var x = 0 +var x = 0; /* until(x==10) { println(x++) } */ -(`x).println() \ No newline at end of file + +println(`x); + +AST.__proto__ = Object; + +for (key in AST) AST[key].__proto__ = AST; + +/* +{ + var k= keys(AST); + var n= length(k); + for (i = 0; i < n; ++i) + AST[k[i]].__proto__ = AST; +}; +*/ + +(`x).println();