From 3e08cb939478af58aa3395c14f7731beff2e7b16 Mon Sep 17 00:00:00 2001 From: mtardy Date: Fri, 14 Aug 2020 10:39:30 +0200 Subject: [PATCH] Merge binary operators into assignments --- parse.leg | 241 +++++++++++++++++++++++++++++++----------------------- 1 file changed, 138 insertions(+), 103 deletions(-) diff --git a/parse.leg b/parse.leg index 37f251f..822a3dd 100644 --- a/parse.leg +++ b/parse.leg @@ -85,7 +85,7 @@ oop globals= 0; 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(update) _DO(this) _DO(fixed) _DO(operator) #define _DO(NAME) oop NAME##_symbol; DO_SYMBOLS() @@ -144,6 +144,9 @@ 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; } } @@ -156,13 +159,24 @@ oop setVariable(oop object, oop key, oop value) oop obj= object; while (!map_hasKey(obj, key)) { obj= map_get(obj, __proto___symbol); - if (null == object) { + if (null == obj) { return map_set(object, key, value); } } return map_set(obj, key, value); } +oop getMember(oop object, oop key) +{ + if (!map_hasKey(object, key)) { + printf("\nUndefined: ."); + println(key); + exit(1); + return null; + } + return map_get(object, key); +} + oop newMap(oop value) { oop map = newObject(map_proto); @@ -231,10 +245,10 @@ oop newSymbol(oop name) return symbol; } -oop newInteger(int value) +oop newInteger(oop value) { oop integer = newObject(integer_proto); - map_set(integer, value_symbol, makeInteger(value)); + map_set(integer, value_symbol, value); return integer; } @@ -396,12 +410,22 @@ oop newBinary(oop proto, oop lhs, oop rhs) return obj; } -oop newSetMap(oop proto, oop map, oop key, oop value) +oop newAssign(oop proto, oop lhs, oop operator, oop rhs) { oop obj = newObject(proto); - map_set(obj, map_symbol, map); - map_set(obj, key_symbol, key); - map_set(obj, value_symbol, value); + 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; } @@ -484,6 +508,12 @@ oop newContinue(void) oop fold(oop ast); +int isSyntax(char *s) +{ + printf("IS SYNTAX %s\n", s); + return 0; +} + #define YYSTYPE oop YYSTYPE yylval; @@ -496,6 +526,10 @@ void error(char *text) oop eval(oop scope, oop ast); +struct _yycontext; + +int yyparsefrom(int (*yystart)(struct _yycontext *yy)); + %} start = - ( e:stmt { yylval = e } @@ -508,12 +542,17 @@ error = eol* < (!eol .)* eol* (!eol .)* > { error(yytext) } stmt = e:exp SEMICOLON* { $$ = e } | s:block { $$ = newBlock(s) } +block = LCB m:makeMap + ( s:stmt { map_append(m, s) } + ) * + RCB { $$ = m } + exp = VAR l:IDENT ASSIGN e:exp { $$ = newDeclaration(l, e) } | VAR l:IDENT { $$ = newDeclaration(l, null) } - | FUN l:IDENT p:paramList e:stmt { $$ = newFunc(l, p, e, null) } - | FUN p:paramList e:stmt { $$ = newFunc(null, p, e, null) } - | SYNTAX l:IDENT p:paramList e:stmt { $$ = newFunc(l, p, e, makeInteger(1)) } - | SYNTAX p:paramList e:stmt { $$ = newFunc(null, p, e, makeInteger(1)) } + | FUN l:IDENT p:paramList e:stmt { $$ = newFunc(l, p, e, null) } + | FUN p:paramList e:stmt { $$ = newFunc(null, p, e, null) } + | SYNTAX l:IDENT p:paramList e:stmt { $$ = newFunc(l, p, e, makeInteger(1)) } + | SYNTAX p:paramList e:stmt { $$ = newFunc(null, p, e, makeInteger(1)) } | IF LPAREN c:exp RPAREN t:stmt ELSE f:stmt { $$ = newIf(c, t, f ) } | IF LPAREN c:exp RPAREN t:stmt { $$ = newIf(c, t, null) } | WHILE LPAREN c:exp RPAREN s:stmt { $$ = newWhile(c, s) } @@ -524,51 +563,22 @@ exp = VAR l:IDENT ASSIGN e:exp { $$ = newDeclarati | RETURN { $$ = newReturn(null) } | BREAK { $$ = newBreak() } | CONTINUE { $$ = newContinue() } - | l:IDENT - ( ASSIGN e:exp { $$ = newBinary(assign_proto, l, e) } - | ASSIGNADD e:exp { $$ = newBinary(assignAdd_proto, l, e) } - | ASSIGNSUB e:exp { $$ = newBinary(assignSub_proto, l, e) } - | ASSIGNMUL e:exp { $$ = newBinary(assignMul_proto, l, e) } - | ASSIGNDIV e:exp { $$ = newBinary(assignDiv_proto, l, e) } - | ASSIGNMOD e:exp { $$ = newBinary(assignMod_proto, l, e) } - | ASSIGNBITOR e:exp { $$ = newBinary(assignBitor_proto , l, e) } - | ASSIGNBITXOR e:exp { $$ = newBinary(assignBitxor_proto, l, e) } - | ASSIGNBITAND e:exp { $$ = newBinary(assignBitand_proto, l, e) } - | ASSIGNSHLEFT e:exp { $$ = newBinary(assignShleft_proto , l, e) } - | ASSIGNSHRIGHT e:exp { $$ = newBinary(assignShright_proto, l, e) } - ) - | l:postfix DOT i:IDENT - ( ASSIGN e:exp { $$ = newSetMap(setMember_proto, l, i, e) } - | ASSIGNADD e:exp { $$ = newSetMap(setMemberAdd_proto, l, i, e) } - | ASSIGNSUB e:exp { $$ = newSetMap(setMemberSub_proto, l, i, e) } - | ASSIGNMUL e:exp { $$ = newSetMap(setMemberMul_proto, l, i, e) } - | ASSIGNDIV e:exp { $$ = newSetMap(setMemberDiv_proto, l, i, e) } - | ASSIGNMOD e:exp { $$ = newSetMap(setMemberMod_proto, l, i, e) } - | ASSIGNBITOR e:exp { $$ = newSetMap(setMemberBitor_proto, l, i, e) } - | ASSIGNBITXOR e:exp { $$ = newSetMap(setMemberBitxor_proto, l, i, e) } - | ASSIGNBITAND e:exp { $$ = newSetMap(setMemberBitand_proto, l, i, e) } - | ASSIGNSHLEFT e:exp { $$ = newSetMap(setMemberShleft_proto, l, i, e) } - | ASSIGNSHRIGHT e:exp { $$ = newSetMap(setMemberShright_proto, l, i, e) } - ) - | l:postfix LBRAC i:exp RBRAC - ( ASSIGN e:exp { $$ = newSetMap(setIndex_proto, l, i, e) } - | ASSIGNADD e:exp { $$ = newSetMap(setIndexAdd_proto, l, i, e) } - | ASSIGNSUB e:exp { $$ = newSetMap(setIndexSub_proto, l, i, e) } - | ASSIGNMUL e:exp { $$ = newSetMap(setIndexMul_proto, l, i, e) } - | ASSIGNDIV e:exp { $$ = newSetMap(setIndexDiv_proto, l, i, e) } - | ASSIGNMOD e:exp { $$ = newSetMap(setIndexMod_proto, l, i, e) } - | ASSIGNBITOR e:exp { $$ = newSetMap(setIndexBitor_proto, l, i, e) } - | ASSIGNBITXOR e:exp { $$ = newSetMap(setIndexBitxor_proto, l, i, e) } - | ASSIGNBITAND e:exp { $$ = newSetMap(setIndexBitand_proto, l, i, e) } - | ASSIGNSHLEFT e:exp { $$ = newSetMap(setIndexShleft_proto, l, i, e) } - | ASSIGNSHRIGHT e:exp { $$ = newSetMap(setIndexShright_proto, l, i, e) } - ) - | c:cond { $$ = c } - -block = LCB m:makeMap - ( s:stmt { map_append(m, s) } - ) * - RCB { $$ = m } + | 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) } + | c:cond { $$ = c } + +assignOp = ASSIGN { $$= null } + | ASSIGNADD { $$= add_symbol } + | ASSIGNSUB { $$= sub_symbol } + | ASSIGNMUL { $$= mul_symbol } + | ASSIGNDIV { $$= div_symbol } + | ASSIGNMOD { $$= mod_symbol } + | ASSIGNBITOR { $$= bitor_symbol } + | ASSIGNBITXOR { $$= bitxor_symbol } + | ASSIGNBITAND { $$= bitand_symbol } + | ASSIGNSHLEFT { $$= shleft_symbol } + | ASSIGNSHRIGHT { $$= shright_symbol } switch = SWITCH LPAREN e:exp RPAREN LCB statements:makeMap labels:makeMap @@ -582,24 +592,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) } @@ -619,9 +629,9 @@ 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) } - )* { $$ = l } + ( PLUS r:prod { l = newBinary(add_proto, l, r) } + | MINUS r:prod { l = newBinary(sub_proto, l, r) } + )* { $$ = l } prod = l:prefix ( MULTI r:prefix { l = newBinary(mul_proto, l, r) } @@ -629,15 +639,15 @@ prod = l:prefix | MODULO r:prefix { l = newBinary(mod_proto, l, r) } )* { $$ = l } -prefix = PLUS n:prefix { $$= n } - | MINUS n:prefix { $$= newUnary(neg_proto, n) } - | TILDE n:prefix { $$= newUnary(com_proto, n) } - | PLING n:prefix { $$= newUnary(not_proto, n) } - | PLUSPLUS n:prefix { $$= newPreIncrement(n) } - | MINUSMINUS n:prefix { $$= newPreDecrement(n) } - | BACKTICK n:prefix { $$ = newUnary(quasiquote_proto, n) } - | AT n:prefix { $$ = newUnary(unquote_proto, n) } - | n:postfix { $$= n } +prefix = PLUS n:prefix { $$= n } + | MINUS n:prefix { $$= newUnary(neg_proto, n) } + | TILDE n:prefix { $$= newUnary(com_proto, n) } + | PLING n:prefix { $$= newUnary(not_proto, n) } + | PLUSPLUS n:prefix { $$= newPreIncrement(n) } + | MINUSMINUS n:prefix { $$= newPreDecrement(n) } + | BACKTICK n:prefix { $$ = newUnary(quasiquote_proto, n) } + | AT n:prefix { $$ = newUnary(unquote_proto, n) } + | n:postfix { $$= n } postfix = i:value ( DOT s:IDENT a:argumentList { i = newInvoke(i, s, a) } | DOT s:IDENT !assignOp { i = newGetMap(getMember_proto, i, s) } @@ -647,18 +657,6 @@ postfix = i:value ( DOT s:IDENT a:argumentList { i = newInvoke( | MINUSMINUS { i = newPostDecrement(i) } ) * { $$ = i } -assignOp = ASSIGN - | ASSIGNADD - | ASSIGNSUB - | ASSIGNMUL - | ASSIGNDIV - | ASSIGNMOD - | ASSIGNBITOR - | ASSIGNBITXOR - | ASSIGNBITAND - | ASSIGNSHLEFT - | ASSIGNSHRIGHT - paramList = LPAREN m:makeMap ( i:IDENT { map_append(m, i) } ( COMMA i:IDENT { map_append(m, i) } @@ -673,7 +671,7 @@ argumentList = LPAREN m:makeMap ) ? RPAREN { $$ = m } -value = n:NUMBER { $$ = n } +value = n:NUMBER { $$ = newInteger(n) } | s:STRING { $$ = newString(s) } | s:symbol { $$ = s } | m:map { $$ = newMap(m) } @@ -691,13 +689,21 @@ symbol = HASH ( i:IDENT { $$ = newSymbol(i) } ) map = LCB m:makeMap - ( k:IDENT COLON v:exp { map_set(m, k, v) } - ( COMMA k:IDENT COLON v:exp { map_set(m, k, v) } + ( k:key COLON v:exp { map_set(m, k, v) } + ( COMMA k:key COLON v:exp { map_set(m, k, v) } ) * ) ? RCB { $$ = m } + | LBRAC m:makeMap + ( v:exp { map_append(m, v) } + ( COMMA v:exp { map_append(m, v) } + ) * + ) ? + RBRAC { $$ = m } + +makeMap = { $$ = makeMap() } -makeMap= { $$ = makeMap() } +key = IDENT | NUMBER - = (blank | comment)* @@ -712,10 +718,10 @@ keyword = FUN | SYNTAX | VAR | SWITCH | CASE | DEFAULT | DO | FOR | WHILE | IF | IDENT = !keyword < [a-zA-Z_][a-zA-Z0-9_]* > - { $$ = intern(yytext) } -NUMBER = '0b' < [01]+ > - { $$ = newInteger(strtol(yytext, 0, 2)) } - | '0x' < [0-9a-fA-F]+ > - { $$ = newInteger(strtol(yytext, 0, 16)) } - | '0' < [0-7]+ > - { $$ = newInteger(strtol(yytext, 0, 8)) } - | < [0-9]+ > - { $$ = newInteger(strtol(yytext, 0, 10)) } +NUMBER = '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)) } FUN = 'fun' ![a-zA-Z0-9_] - SYNTAX = 'syntax' ![a-zA-Z0-9_] - @@ -905,6 +911,29 @@ oop fold(oop ast) return null; } +oop applyOperator(oop op, oop lhs, oop rhs) +{ + if (null != op) { assert(is(Symbol, op)); + switch (get(op, Symbol, prototype)) { + case t_add: return makeInteger(getInteger(lhs) + getInteger(rhs)); + case t_sub: return makeInteger(getInteger(lhs) - getInteger(rhs)); + case t_mul: return makeInteger(getInteger(lhs) * getInteger(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 eval(oop scope, oop ast) @@ -1103,7 +1132,9 @@ oop eval(oop scope, oop ast) } 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); @@ -1260,7 +1291,9 @@ oop eval(oop scope, oop ast) 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, getMember(map, key), value); if (is(Function, value) && null == get(value, Function, name)) { set(value, Function, name, key); } @@ -1292,7 +1325,9 @@ oop eval(oop scope, oop ast) 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)); + if (null != op) value= applyOperator(op, map_get(map, key), value); return map_set(map, key, value); } # define SETINDEXOP(OPERATION, OPERATOR) \ @@ -1482,8 +1517,8 @@ oop prim_exit(oop params) { int status= 0; if (map_hasIntegerKey(params, 0)) { - oop arg= get(params, Map, elements)[0].value; - if (isInteger(arg)) status= getInteger(arg); + oop arg= get(params, Map, elements)[0].value; + if (isInteger(arg)) status= getInteger(arg); } exit(status); } @@ -1491,8 +1526,8 @@ oop prim_exit(oop params) oop prim_keys(oop params) { if (map_hasIntegerKey(params, 0)) { - oop arg= get(params, Map, elements)[0].value; - if (is(Map, arg)) return map_keys(arg); + oop arg= get(params, Map, elements)[0].value; + if (is(Map, arg)) return map_keys(arg); } return null; }