@ -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) _(Ref Var) _(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) _(Ref Var) _(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:x expr { Object_put(a, k, e) }
| e:x expr { 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:x expr { Object_put(a, k, e) }
| e:x expr { 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);
