Add symbols #O, #d, #v and Symbol.setop() primitive. Add primitive method Symbol.setopt(N) to set command-line option at runtime. Add primitive method Symbol.defined() to test if a variable name has been defined. Overload primitive "+" to concatenate strings. Add stack of namespaces, initialised to empty object. refvar() and getvar() search namespaces, from most to least recent, when looking for global variables. setvar() always defines globals in the most recent namespace regardless of any existing shadowed definitions. Make OBJ::NAME a synonym for OBJ.NAME except that OBJ::NAME() applies a function whereas OBJ.NAME() invokes method NAME on OBJ. Add primitive error() to print source location, error message, and backtrace.

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);