diff --git a/minproto.leg b/minproto.leg index 57e4956..4e5f423 100644 --- a/minproto.leg +++ b/minproto.leg @@ -1,6 +1,6 @@ # minproto.leg -- minimal prototype langauge for semantic experiments # -# last edited: 2024-05-15 19:13:04 by piumarta on debian +# last edited: 2024-05-18 08:41:26 by piumarta on zora %{ ; @@ -129,7 +129,7 @@ doTypes(makeProto); doProperties(declareProp); #undef declareProp -#define doSymbols(_) _(t) _(name) _(expr) _(function) _(arguments) _(object) _(index) _(key) _(value) _(self) _(method) _(parameters) _(body) _(lambda) _(environment) _(operation) _(full) _(condition) _(consequent) _(alternate) _(expression) _(identifier) _(initialise) _(update) _(first) _(last) _(fixed) _(keyvals) _(__globals__) +#define doSymbols(_) _(t) _(name) _(expr) _(function) _(arguments) _(object) _(index) _(key) _(value) _(self) _(method) _(parameters) _(body) _(lambda) _(environment) _(operation) _(full) _(condition) _(consequent) _(alternate) _(expression) _(identifier) _(initialise) _(update) _(first) _(last) _(fixed) _(keyvals) _(__namespaces__) _(O) _(d) _(v) #define declareSym(NAME) oop sym_##NAME = 0; doSymbols(declareSym); @@ -212,6 +212,8 @@ union object _nil = { Undefined }; #define nil (&_nil) +oop namespaces = nil; + #define UNDEFINED 0 enum type getType(oop obj) @@ -414,6 +416,13 @@ char *String_content(oop str) return _get(str, String,value); } +oop String_concat(oop a, oop b) +{ + oop result = newStringLen(_get(a, String,value), _get(a, String,length)); + String_appendAllLen(result, _get(b, String,value), _get(b, String,length)); + return result; +} + oop newStringEscaped(char *string) { oop buf = newStringLen(0, 0); @@ -686,38 +695,57 @@ oop Object_get(oop obj, oop key) return nil; } -oop *refvar(oop obj, oop key) +oop *_refvar(oop obj, oop key) { while (is(Object, obj)) { ssize_t ind = Object_find(obj, key); if (ind >= 0) return &_get(obj, Object,properties)[ind].val; obj = _getDelegate(obj); } + int numspaces = _get(namespaces, Object,isize); + if (numspaces) { + oop *nss = _get(namespaces, Object,indexed); + for (int i = numspaces; i--;) { + oop ns = nss[i]; + while (is(Object, ns)) { + ssize_t ind = Object_find(ns, key); + if (ind >= 0) return &_get(ns, Object,properties)[ind].val; + ns = _getDelegate(ns); + } + } + } oop *ref = &_get(key, Symbol,value); // asserts is(Symbol,key) + return ref; +} + +oop *refvar(oop obj, oop key) +{ + oop *ref = _refvar(obj, key); if (UNDEFINED == *ref) fatal("undefined variable: %s", storeString(key, 0)); return ref; } oop getvar(oop obj, oop key) { - while (is(Object, obj)) { - ssize_t ind = Object_find(obj, key); - if (ind >= 0) return _get(obj, Object,properties)[ind].val; - obj = _getDelegate(obj); - } - oop value = _get(key, Symbol,value); // asserts is(Symbol,key) - if (UNDEFINED == value) fatal("undefined variable: %s", storeString(key, 0)); - return value; + return *refvar(obj, key); } +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); } - return is(Symbol, key) ? _set(key, Symbol,value, val) : nil; + int numspaces = _get(namespaces, Object,isize); + if (numspaces) { + oop *nss = _get(namespaces, Object,indexed); + return Object_put(nss[numspaces - 1], key, val); + } + return _get(key, Symbol,value) = val; // asserts is(Symbol,key) } oop Object_put(oop obj, oop key, oop val) @@ -1161,12 +1189,12 @@ oop storeOn(oop buf, oop obj, int indent) } struct property *kvs = _get(obj, Object,properties); size = _get(obj, Object,psize); - for (int i = 0; i < size; ++i) { - if (kvs[i].key == prop_delegate && kvs[i].val == pObject) continue; - if (i) String_appendAll(buf, ", "); - codeOn(buf, kvs[i].key, indent); + for (int j = 0; j < size; ++j) { + if (kvs[j].key == prop_delegate && kvs[j].val == pObject) continue; + if (i++) String_appendAll(buf, ", "); + codeOn(buf, kvs[j].key, indent); String_appendAll(buf, ": "); - codeOn(buf, kvs[i].val, indent); + codeOn(buf, kvs[j].val, indent); } String_append(buf, ']'); break; @@ -1990,6 +2018,16 @@ oop binShr(oop l, oop r) return 0; } +oop binAdd(oop l, oop r) +{ + int tl = getType(l), tr = getType(r); + if (Integer == tl && Integer == tr) return newInteger(_integerValue(l ) + _integerValue(r )); + if (Float == tl || Float == tr) return newFloat ( floatValue (l, "+") + floatValue (r, "+")); + if (String == tl && String == tr) return String_concat(l, r); + fatal("+: illegal operand types %s and %s", getTypeName(l), getTypeName(r)); + return 0; +} + #define binop(NAME, OP) \ oop NAME(oop l, oop r) \ { \ @@ -2000,7 +2038,6 @@ oop NAME(oop l, oop r) return 0; \ } -binop(binAdd, +); binop(binSub, -); binop(binMul, *); @@ -2703,6 +2740,7 @@ stmt = LET l:mklet k:id ASSIGN v:expr { Let_append(l, k, v) } u:expr RPAREN s:stmt { $$ = newFor(i, c, u, s) } | 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 } @@ -2780,6 +2818,7 @@ 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)) } @@ -2886,7 +2925,8 @@ HASH = "#" - SEMI = ";" - ASSIGN = "=" ![=] - COMMA = "," - -COLON = ":" - +COLON = ":" ![:] - +CCOLON = "::" - LPAREN = "(" - RPAREN = ")" - LBRAK = "[" - @@ -3070,7 +3110,7 @@ oop eval(oop exp, oop env) # if PRIMCLOSURE if (Lambda == type) return newClosure(exp, env); # endif - if (Object != getType(exp)) return exp; + if (Object != type) return exp; if (!opt_O) Object_push(trace, exp); oop result = evalobj(exp, env); if (!opt_O) Object_pop(trace); @@ -3296,6 +3336,35 @@ oop prim_exit(oop func, oop self, oop args, oop env) return nil; } +oop prim_error(oop func, oop self, oop args, oop env) +{ + int argc = _get(args, Object,isize); + if (argc != 1) fatal("error: one argument expected"); + oop arg = _get(args, Object,indexed)[0]; + if (!is(String, arg)) fatal("error: non-string argument"); + fatal("%.*s", _get(arg, String,length), _get(arg, String,value)); + return 0; +} + +oop prim_Symbol_setopt(oop func, oop self, oop args, oop env) +{ assert(is(Symbol, self)); + int argc = _get(args, Object,isize); + if (argc != 1) fatal("setopt: one argument expected"); + oop val = _get(args, Object,indexed)[0]; + if (!isInteger(val)) fatal("setopt: non-integer option value: %s", storeString(val, 0)); + int optval = _integerValue(val); + if (sym_O == self) opt_O = optval; + else if (sym_d == self) opt_d = optval; + else if (sym_v == self) opt_v = optval; + else fatal("setopt: unknown option: %s", storeString(self, 0)); + return val; +} + +oop prim_Symbol_defined(oop func, oop self, oop args, oop env) +{ + return *_refvar(env, self) ? sym_t : nil; +} + oop replFile(FILE *in) { int oldline = lineno; @@ -3315,7 +3384,7 @@ oop replFile(FILE *in) printf(">>> "); (opt_d ? println : codeln)(yysval, opt_v >2); } - result = eval(yysval, _get(sym___globals__, Symbol,value)); + result = eval(yysval, nil); if (opt_v) { printf("==> "); if (opt_v >= 3) storeln(result, 1); @@ -3407,6 +3476,7 @@ int main(int argc, char **argv) prim(chr , prim_chr); prim(readfile , prim_readfile); prim(exit , prim_exit); + prim(fatal , prim_error); # undef prim @@ -3419,10 +3489,12 @@ int main(int argc, char **argv) method(Object,keys, prim_keys ); method(Object,allKeys, prim_allKeys); method(Object,sorted, prim_sorted ); + method(Symbol,defined, prim_Symbol_defined); + method(Symbol,setopt, prim_Symbol_setopt); # undef method - _set(sym___globals__, Symbol,value, nil); + namespaces = _set(sym___namespaces__, Symbol,value, new(pObject)); trace = new(pObject);