@ -1,6 +1,6 @@
# minproto.leg -- minimal prototype langauge for semantic experiments
#
# last edited: 2024-05-14 06:33:02 by piumarta on m1mbp
# last edited: 2024-05-14 12:14:06 by piumarta on zora
%{
;
@ -127,7 +127,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)
#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 declareSym(NAME) oop sym_##NAME = 0;
doSymbols(declareSym);
@ -155,11 +155,10 @@ int nnlrs = 0;
int maxnlrs = 0;
oop valnlr = 0;
#define nlrPush() ({ \
if (nnlrs == maxnlrs) nlrs = realloc(nlrs, sizeof(jmp_buf) * ++maxnlrs); \
++nnlrs; \
nlrs[nnlrs - 1].ntrace = _get(trace, Object,isize); \
setjmp(nlrs[nnlrs - 1].env); \
#define nlrPush() ({ \
if (++nnlrs >= maxnlrs) nlrs = realloc(nlrs, sizeof(struct NLR) * ++maxnlrs); \
nlrs[nnlrs - 1].ntrace = _get(trace, Object,isize); \
setjmp(nlrs[nnlrs - 1].env); \
})
#define nlrReturn(VAL, TYPE) { \
@ -2931,6 +2930,26 @@ oop prim_length(oop func, oop self, oop args, oop env)
return newInteger(_get(self, Object,isize));
}
oop sortObject(oop obj, char *who)
{
int limit = _get(obj, Object,isize);
oop *elts = _get(obj, Object,indexed);
for (int i = 0; i < limit - 1; ++i) {
int mindex = i;
oop minobj = elts[i];
for (int j = i + 1; j < limit; ++j) {
oop newobj = elts[j];
if (cmp(newobj, minobj, who) < 0) mindex = j, minobj = newobj;
}
if (mindex != i) {
oop tmpobj = elts[i];
elts[i] = minobj;
elts[mindex] = tmpobj;
}
}
return obj;
}
oop prim_keys(oop func, oop self, oop args, oop env)
{
oop keys = new(pObject);
@ -2944,6 +2963,7 @@ oop prim_keys(oop func, oop self, oop args, oop env)
int size = _get(self, Object,psize);
struct property *kvs = _get(self, Object,properties);
for (int i = 0; i < size; ++i) Object_push(keys, kvs[i].key);
sortObject(keys, "keys");
break;
}
# if PRIMCLOSURE
@ -3133,7 +3153,7 @@ oop replFile(FILE *in)
printf(">>> ");
(opt_d ? println : codeln)(yysval, opt_v >2);
}
result = eval(yysval, nil );
result = eval(yysval, _get(sym___globals__, Symbol,value) );
if (opt_v) {
printf("==> ");
if (opt_v >= 3) storeln(result, 1);
@ -3230,6 +3250,8 @@ int main(int argc, char **argv)
Object_put(pObject, intern("length"), newPrimitive(prim_length));
Object_put(pObject, intern("keys"), newPrimitive(prim_keys ));
_set(sym___globals__, Symbol,value, nil);
trace = new(pObject);
signal(SIGINT, sigint);