From 883a9cf7c2cb04d05e1a1b304e55c9512fb064d8 Mon Sep 17 00:00:00 2001 From: Ian Piumarta Date: Tue, 28 May 2024 19:27:13 +0900 Subject: [PATCH] Remove let and ::. Add global keyword. Add Ref/Get/SetSym. Cast the 0 terminator in genericError to oop to ensure va_arg picks it up. Better error messages for broken statements in blocks and broken expressions in argument lists. --- minproto.leg | 213 +++++++++++++++++++++++++++++---------------------- 1 file changed, 122 insertions(+), 91 deletions(-) diff --git a/minproto.leg b/minproto.leg index 6a685be..5589431 100644 --- a/minproto.leg +++ b/minproto.leg @@ -1,6 +1,6 @@ # minproto.leg -- minimal prototype langauge for semantic experiments # -# last edited: 2024-05-26 17:45:40 by piumarta on zora +# last edited: 2024-05-28 16:25:46 by piumarta on zora-1034.local %{ ; @@ -104,9 +104,9 @@ oop printOn(oop buf, oop obj, int indent); #endif #if PRIMCLOSURE -#define doProtos(_) _(Object) _(RefVar) _(GetVar) _(SetVar) _(RefProp) _(GetProp) _(SetProp) _(RefArray) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Continue) _(Break) _(Return) _(TryCatch) _(TryEnsure)_(Raise)_(Binop) _(Unyop) _(Let) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) +#define doProtos(_) _(Object) _(RefSym) _(GetSym) _(SetSym) _(RefVar) _(GetVar) _(SetVar) _(RefProp) _(GetProp) _(SetProp) _(RefArray) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Continue) _(Break) _(Return) _(TryCatch) _(TryEnsure)_(Raise)_(Binop) _(Unyop) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) #else -#define doProtos(_) _(Object) _(RefVar) _(GetVar) _(SetVar) _(RefProp) _(GetProp) _(SetProp) _(RefArray) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Continue) _(Break) _(Return) _(TryCatch) _(TryEnsure) _(Raise) _(Binop) _(Unyop) _(Let) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) _(Lambda) _(Closure) +#define doProtos(_) _(Object) _(RefSym) _(GetSym) _(SetSym) _(RefVar) _(GetVar) _(SetVar) _(RefProp) _(GetProp) _(SetProp) _(RefArray) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Continue) _(Break) _(Return) _(TryCatch) _(TryEnsure) _(Raise) _(Binop) _(Unyop) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) _(Lambda) _(Closure) #endif #define declareProto(NAME) oop p##NAME = 0; @@ -814,16 +814,17 @@ oop Object_put(oop obj, oop key, oop val); oop setvar(oop obj, oop key, oop val) { oop env = obj; - while (is(Object, obj)) { - ssize_t ind = Object_find(obj, key); - if (ind >= 0) return _get(obj, Object,properties)[ind].val = val; - obj = _getDelegate(obj); + while (is(Object, env)) { + ssize_t ind = Object_find(env, key); + if (ind >= 0) return _get(env, Object,properties)[ind].val = val; + env = _getDelegate(env); } int numspaces = _get(namespaces, Object,isize); if (numspaces) { oop *nss = _get(namespaces, Object,indexed); return Object_put(nss[numspaces - 1], key, val); } + if (nil != obj) return Object_put(obj, key, val); return _get(key, Symbol,value) = val; // asserts is(Symbol,key) } @@ -897,29 +898,33 @@ oop newObjectWith(int isize, oop *indexed, int psize, struct property *propertie void genericError(char *who, char *message, char *kind, ...); +#define END (oop)0 + void typeError(char *who, char *msg, oop value) { genericError(who, msg, "type error", - sym_value, value, 0); } + sym_value, value, END); } void typeError2(char *who, char *msg, oop lhs, oop rhs) { genericError(who, msg, "type error", - sym_operand1, lhs, sym_operand2, rhs, 0); } + sym_operand1, lhs, sym_operand2, rhs, END); } void rangeError(char *who, char *msg, oop obj, int index) { genericError(who, msg, "index error", - sym_object, obj, sym_index, newInteger(index), 0); } + sym_object, obj, sym_index, newInteger(index), END); } void valueError(char *who, char *msg, oop value) { genericError(who, msg, "value error", - sym_value, value, 0); } + sym_value, value, END); } void keyError(char *who, char *msg, oop object, oop key) { genericError(who, msg, "key error", - sym_object, object, sym_key, key, 0); } + sym_object, object, sym_key, key, END); } void undefinedError(oop name) { genericError( 0, 0, "undefined name", - sym_name, name, 0); } + sym_name, name, END); } + +void syntaxError(char *msg) { genericError( 0, msg, "syntax error", END); } -void syntaxError(char *msg) { genericError( 0, msg, "syntax error", 0); } +void unknownError(char *msg) { genericError( 0, msg, "error", END); } -void unknownError(char *msg) { genericError( 0, msg, "error", 0); } +void keyboardInterrupt(void) { genericError( 0, 0, "keyboard interrupt", END); } -void keyboardInterrupt(void) { genericError( 0, 0, "keyboard interrupt", 0); } +#undef END #else @@ -1504,7 +1509,6 @@ Input *makeInput(void) result= (input->position >= input->size) \ ? 0 \ : ((*(buf)= input->text[input->position++]), 1); \ - /* printf("<%c>", *(buf)); */ \ } YYSTYPE yysval = 0; @@ -1519,13 +1523,6 @@ void Object_codeOn(oop exp, oop str, oop env) storeOn(str, exp, 0); } -oop newRefVar(oop name) -{ - oop o = new(pRefVar); - Object_put(o, sym_name, name); - return o; -} - extern inline oop mkptr(void *address) { // top 7 bits of virtual addresses are guaranteed to be the same, @@ -1535,6 +1532,76 @@ extern inline oop mkptr(void *address) return o; } +oop newRefSym(oop name) +{ + oop o = new(pRefSym); + Object_put(o, sym_name, name); + return o; +} + +oop RefSym_eval(oop exp, oop env) +{ + oop sym = Object_get(exp, sym_name); + return mkptr(&_get(sym, Symbol,value)); +} + +void RefSym_codeOn(oop exp, oop str, oop env) +{ + String_appendAll(str, "global "); + printOn(str, Object_get(exp, sym_name), 0); +} + +oop newGetSym(oop name) +{ + oop o = new(pGetSym); + Object_put(o, sym_name, name); + return o; +} + +oop GetSym_eval(oop exp, oop env) +{ + oop sym = Object_get(exp, sym_name); + oop val = _get(sym, Symbol,value); + if (UNDEFINED == val) undefinedError(sym); + return val; +} + +void GetSym_codeOn(oop exp, oop str, oop env) +{ + String_appendAll(str, "global "); + printOn(str, Object_get(exp, sym_name), 0); +} + +oop newSetSym(oop name, oop value) +{ + oop o = new(pSetSym); + Object_put(o, sym_name, name); + Object_put(o, sym_value, value); + return o; +} + +oop SetSym_eval(oop exp, oop env) +{ + oop sym = Object_get(exp, sym_name ) ; + oop val = eval(Object_get(exp, sym_value), env); + return _set(sym, Symbol,value, val); +} + +void SetSym_codeOn(oop exp, oop str, oop env) +{ + String_appendAll(str, "global "); + printOn(str, Object_get(exp, sym_name), 0); + String_appendAll(str, " = "); + codeOn(str, Object_get(exp, sym_value), 0); +} + +oop newRefVar(oop name) +{ + oop o = new(pRefVar); + Object_put(o, sym_name, name); + return o; +} + oop RefVar_eval(oop exp, oop env) { return mkptr(refvar(env, Object_get(exp, sym_name))); @@ -2603,46 +2670,6 @@ void Unyop_codeOn(oop exp, oop str, oop env) codeOn(str, value, 0); } -oop newLet(void) -{ - oop o = new(pLet); - Object_put(o, sym_keyvals, new(pObject)); - return o; -} - -oop Let_append(oop let, oop key, oop value) -{ - oop keyvals = Object_getLocal(let, sym_keyvals); - Object_push(keyvals, key); - Object_push(keyvals, value); - return let; -} - -oop Let_eval(oop exp, oop env) -{ - oop keyvals = Object_getLocal(exp, sym_keyvals); - oop *indexed = get(keyvals, Object,indexed); - int isize = _get(keyvals, Object,isize); - oop result = nil; - for (int i = 0; i < isize - 1; i += 2) - Object_put(env, indexed[i], (result = eval(indexed[i+1], env))); - return result; -} - -void Let_codeOn(oop exp, oop str, oop env) -{ - oop keyvals = Object_getLocal(exp, sym_keyvals); - oop *indexed = get(keyvals, Object,indexed); - int isize = _get(keyvals, Object,isize); - String_appendAll(str, "let "); - for (int i = 0; i < isize - 1; i += 2) { - if (i) String_appendAll(str, ", "); - printOn(str, indexed[i], 0); - String_appendAll(str, " = "); - codeOn(str, indexed[i+1], 0); - } -} - oop newIf(oop condition, oop consequent, oop alternate) { oop o = new(pIf); @@ -2992,6 +3019,7 @@ oop lvalue(oop rval) if (kind == pGetVar ) kind = pRefVar; else if (kind == pGetProp ) kind = pRefProp; else if (kind == pGetArray) kind = pRefArray; + else if (kind == pGetSym ) kind = pRefSym; else valueError("=", "non-assignable value", rval); _setDelegate(rval, kind); return rval; @@ -3004,12 +3032,18 @@ oop assign(oop rval, oop value) if (kind == pGetVar ) kind = pSetVar; else if (kind == pGetProp ) kind = pSetProp; else if (kind == pGetArray) kind = pSetArray; + else if (kind == pGetSym ) kind = pSetSym; else valueError("=", "non-assignable value", rval); _setDelegate(rval, kind); Object_put(rval, sym_value, value); return rval; } +void expected(char *what, char *where) +{ + fatal("syntax error: %s expected near: %s", what, where); +} + %} start = - ( s:stmt { yysval = s } @@ -3017,10 +3051,7 @@ start = - ( s:stmt { yysval = s } | < (!EOL .)* > { syntaxError(yytext) } ) -stmt = LET l:mklet k:id ASSIGN v:expr { Let_append(l, k, v) } - ( COMMA k:id ASSIGN v:expr { Let_append(l, k, v) } - )* SEMI { $$ = l } - | WHILE LPAREN c:expr RPAREN s:stmt { $$ = newWhile(c, s) } +stmt = WHILE LPAREN c:expr RPAREN s:stmt { $$ = newWhile(c, s) } | IF LPAREN c:expr RPAREN s:stmt ( ELSE t:stmt { $$ = newIf(c, s, t ) } | { $$ = newIf(c, s, nil) } @@ -3036,19 +3067,16 @@ stmt = LET l:mklet k:id ASSIGN v:expr { Let_append(l, k, v) } TO b:expr RPAREN s:stmt { $$ = newForFromTo(i, a, b, s) } | FOR LPAREN i:expr SEMI c:expr SEMI u:expr RPAREN s:stmt { $$ = newFor(i, c, u, s) } - | i:id p:params b:block { $$ = newSetVar(i, newLambda(p, b)) } | TRY t:stmt ( CATCH LPAREN i:id RPAREN c:stmt { $$ = newTryCatch(t, i, c) } | ENSURE e:stmt { $$ = newTryEnsure(t, e) } ) | RAISE e:expr EOS { $$ = newRaise(e) } + | i:id p:params b:block { $$ = newSetVar(i, newLambda(p, b)) } | v:proto DOT i:id p:params b:block { $$ = newSetProp(v, i, newLambda(p, b)) } - | v:proto CCOLON i:id p:params b:block { $$ = newSetProp(v, i, newLambda(p, b)) } | b:block { $$ = newBlock(b) } | e:expr EOS { $$ = e } -mklet = { $$ = newLet() } - proto = v:var ( DOT j:id !LPAREN { v = newGetProp(v, j) } )* { $$ = v } @@ -3121,7 +3149,6 @@ postfix = p:primary | { p = newGetProp(p, i) } ) | a:args !LBRACE { p = newApply(p, a) } - | CCOLON i:id { p = newGetProp(p, i) } )* ( PPLUS { p = newBinop(opPostAdd, lvalue(p), newInteger( 1)) } | MMINUS { p = newBinop(opPostAdd, lvalue(p), newInteger(-1)) } @@ -3129,11 +3156,11 @@ postfix = p:primary args = LPAREN a:mkobj ( RPAREN - | ( k:id COLON e:expr { Object_put(a, k, e) } - | e:expr { Object_push(a, e) } + | ( k:id COLON e:xexpr { Object_put(a, k, e) } + | e:xexpr { Object_push(a, e) } ) - ( COMMA ( k:id COLON e:expr { Object_put(a, k, e) } - | e:expr { Object_push(a, e) } + ( COMMA ( k:id COLON e:xexpr { Object_put(a, k, e) } + | e:xexpr { Object_push(a, e) } ) )* RPAREN ) { $$ = a } params = LPAREN p:mkobj @@ -3165,7 +3192,9 @@ literal = LBRAK o:mkobj block = LBRACE b:mkobj ( e:stmt { Object_push(b, e) } - )* RBRACE { $$ = b } + )* ( RBRACE { $$ = b } + | error @{ expected("statement or \x7D", yytext) } + ) nil = NIL { $$ = nil } @@ -3191,7 +3220,8 @@ char = "\\" ( ["'\\abfnrtv] symbol = HASH i:id { $$ = i } -var = i:id { $$ = newGetVar(i) } +var = GLOBAL i:id { $$ = newGetSym(i) } + | i:id { $$ = newGetVar(i) } id = < LETTER ALNUM* > - { $$ = intern(yytext) } @@ -3199,7 +3229,7 @@ BIGIT = [0-1] OIGIT = [0-7] DIGIT = [0-9] HIGIT = [0-9A-Fa-f] -LETTER = [A-Za-z_] +LETTER = [A-Za-z_$?] ALNUM = LETTER | DIGIT SIGN = [-+] EXP = [eE] SIGN DIGIT+ @@ -3219,7 +3249,6 @@ FOR = "for" !ALNUM - IN = "in" !ALNUM - FROM = "from" !ALNUM - TO = "to" !ALNUM - -LET = "let" !ALNUM - CONT = "continue" !ALNUM - BREAK = "break" !ALNUM - RETURN = "return" !ALNUM - @@ -3227,6 +3256,7 @@ TRY = "try" !ALNUM - CATCH = "catch" !ALNUM - ENSURE = "ensure" !ALNUM - RAISE = "raise" !ALNUM - +GLOBAL = "global" !ALNUM - BQUOTE = "`" - COMMAT = "@" - @@ -3235,7 +3265,6 @@ SEMI = ";" - ASSIGN = "=" ![=] - COMMA = "," - COLON = ":" ![:] - -CCOLON = "::" - LPAREN = "(" - RPAREN = ")" - LBRAK = "[" - @@ -3276,6 +3305,10 @@ DOT = "." - PLING = "!" ![=] - TILDE = "~" - +error = - < (!EOL .)* > + +xexpr = expr | error @{ expected("expression", yytext) } + %%; #define SEND(RCV, MSG) ({ \ @@ -3459,8 +3492,9 @@ oop prim_Object_push(oop func, oop self, oop args, oop env) { assert(is(Object, args)); int argc = _get(args, Object,isize); assert(is(Object, self)); oop *indexed = _get(args, Object,indexed); - for (int i = 0; i < argc; ++i) Object_push(self, indexed[i]); - return self; + oop result = nil; + for (int i = 0; i < argc; ++i) result = Object_push(self, indexed[i]); + return result; } oop prim_Object_pop(oop func, oop self, oop args, oop env) @@ -3906,13 +3940,10 @@ oop replFile(FILE *in) struct property *kvs = _get(valnlr, Object,properties); if (size) String_appendAll(msg, ": "); int n = 0; - printf("MESSAGE "); println(msg, 0); for (int i = 0; i < size; ++i) { if (isSpecial(kvs[i].key)) continue; if (n++) String_appendAll(msg, ", "); String_push(msg, kvs[i].key); - printf("KEY "); println(kvs[i].key, 0); - printf("VAL %p ", kvs[i].val); println(kvs[i].val, 0); String_appendAll(msg, " = "); storeOn(msg, kvs[i].val, 0); } @@ -3923,9 +3954,9 @@ oop replFile(FILE *in) } size = _get(valnlr, Object,isize); oop *elts = _get(valnlr, Object,indexed); - int w = 1 + log10(size); + int w = 2 + log10(size); for (int i = size; i--;) { - String_format(msg, "\n%*d:", w, i); + String_format(msg, "\n%*d: ", w, i); codeOn(msg, elts[i], 0); } trace = nil; @@ -3948,14 +3979,14 @@ oop replFile(FILE *in) # if NONLOCAL nlrPop(); # endif - lineno = oldline; + lineno = oldline; return result; } oop replPath(char *path) { FILE *in = fopen(path, "r"); - if (!in) valueError("REPL", strerror(errno), newString(path)); + if (!in) fatal("%s: %s", path, strerror(errno)); char *oldname = filename; filename = path; oop result = replFile(in);