|
|
@ -1,27 +1,27 @@ |
|
|
|
# minproto.leg -- minimal prototype langauge for semantic experiments |
|
|
|
# |
|
|
|
# last edited: 2024-05-07 23:23:22 by piumarta on m1mbp |
|
|
|
# last edited: 2024-05-09 10:17:11 by piumarta on zora-1034.local |
|
|
|
|
|
|
|
%{ |
|
|
|
; |
|
|
|
#ifndef GC |
|
|
|
# define GC 1 |
|
|
|
# define GC 1 // do not fill memory with unreachable junk |
|
|
|
#endif |
|
|
|
|
|
|
|
#ifndef TAGS |
|
|
|
# define TAGS 1 |
|
|
|
# define TAGS 1 // Integer and Float are immediate values encoded in their object "pointer" |
|
|
|
#endif |
|
|
|
|
|
|
|
#ifndef TYPECODES |
|
|
|
# define TYPECODES 0 |
|
|
|
#ifndef TYPECODES // <ast>.eval() dispatches using switch(), instead of invoking a method |
|
|
|
# define TYPECODES 0 // (approx. 210% performance increase, because no dynamic dispatch in eval()) |
|
|
|
#endif |
|
|
|
|
|
|
|
#ifndef PRIMCLOSURE |
|
|
|
# define PRIMCLOSURE 1 |
|
|
|
#ifndef PRIMCLOSURE // Lambda and Closure are primitive types, not subtypes of Object |
|
|
|
# define PRIMCLOSURE 0 // (approx. 6% performance decrease, because every Object_get() is slower) |
|
|
|
#endif |
|
|
|
|
|
|
|
#ifndef DELOPT |
|
|
|
# define DELOPT 0 |
|
|
|
#ifndef DELOPT // delegate is a member of Object structure, not a normal property |
|
|
|
# define DELOPT 0 // (approx. 60% performance increase, becase no associative lookup of __delegate__) |
|
|
|
#endif |
|
|
|
|
|
|
|
#include <math.h> |
|
|
@ -85,9 +85,9 @@ typedef oop (*prim_t)(oop func, oop self, oop args, oop env); |
|
|
|
#endif |
|
|
|
|
|
|
|
#if PRIMCLOSURE |
|
|
|
#define doProtos(_) _(Object) _(GetVar) _(SetVar) _(GetProp) _(SetProp) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Binop) _(Unyop) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) |
|
|
|
#define doProtos(_) _(Object) _(GetVar) _(SetVar) _(GetProp) _(SetProp) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Binop) _(Unyop) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) _(Range) |
|
|
|
#else |
|
|
|
#define doProtos(_) _(Object) _(GetVar) _(SetVar) _(GetProp) _(SetProp) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Binop) _(Unyop) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) _(Lambda) _(Closure) |
|
|
|
#define doProtos(_) _(Object) _(GetVar) _(SetVar) _(GetProp) _(SetProp) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Binop) _(Unyop) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) _(Lambda) _(Closure) _(Range) |
|
|
|
#endif |
|
|
|
|
|
|
|
#define declareProto(NAME) oop p##NAME = 0; |
|
|
@ -114,7 +114,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) |
|
|
|
#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) _(start) _(end) _(env) |
|
|
|
|
|
|
|
#define declareSym(NAME) oop sym_##NAME = 0; |
|
|
|
doSymbols(declareSym); |
|
|
@ -133,7 +133,7 @@ struct Symbol { enum type type; char *name; oop value; }; |
|
|
|
struct Primitive { enum type type; oop name; prim_t function; }; |
|
|
|
#if PRIMCLOSURE |
|
|
|
struct Lambda { enum type type; oop parameters, body; }; |
|
|
|
struct Closure { enum type type; int fixed; oop lambda, environment; }; |
|
|
|
struct Closure { enum type type; int fixed; oop function, environment; }; |
|
|
|
#endif |
|
|
|
struct Object { enum type type; int isize, icap, psize; |
|
|
|
# if DELOPT |
|
|
@ -424,14 +424,16 @@ oop newLambda(oop parameters, oop body) |
|
|
|
return obj; |
|
|
|
} |
|
|
|
|
|
|
|
oop newClosure(oop lambda, oop environment) |
|
|
|
oop newClosure(oop function, oop environment) |
|
|
|
{ |
|
|
|
oop obj = make(Closure); |
|
|
|
_set(obj, Closure,lambda, lambda); |
|
|
|
_set(obj, Closure,function, function); |
|
|
|
_set(obj, Closure,environment, environment); |
|
|
|
return obj; |
|
|
|
} |
|
|
|
|
|
|
|
int isClosure(oop obj) { return is(Closure, obj); } |
|
|
|
|
|
|
|
#endif |
|
|
|
|
|
|
|
oop macros = 0; |
|
|
@ -530,36 +532,40 @@ char *storeString(oop obj, int indent); |
|
|
|
|
|
|
|
oop Object_get(oop obj, oop key) |
|
|
|
{ |
|
|
|
oop o = obj; |
|
|
|
while (is(Object, o)) { |
|
|
|
ssize_t ind = Object_find(o, key); |
|
|
|
if (ind >= 0) return _get(o, Object,properties)[ind].val; |
|
|
|
o = _getDelegate(o); |
|
|
|
} |
|
|
|
# define makeCase(NAME) case NAME: o = p##NAME; break; |
|
|
|
oop o; |
|
|
|
switch (getType(obj)) { |
|
|
|
doTypes(makeCase); |
|
|
|
case Object: break; |
|
|
|
case Undefined: o = pUndefined; break; |
|
|
|
case Integer: o = pInteger; break; |
|
|
|
case Float: o = pFloat; break; |
|
|
|
case String: o = pString; break; |
|
|
|
case Symbol: o = pSymbol; break; |
|
|
|
case Primitive: o = pPrimitive; break; |
|
|
|
# if PRIMCLOSURE |
|
|
|
case Lambda: |
|
|
|
if (key == sym_parameters) return _get(obj, Lambda,parameters); |
|
|
|
if (key == sym_body ) return _get(obj, Lambda,body ); |
|
|
|
o = pLambda; |
|
|
|
break; |
|
|
|
case Closure: |
|
|
|
if (key == sym_function ) return _get(obj, Closure,function ); |
|
|
|
if (key == sym_environment) return _get(obj, Closure,environment); |
|
|
|
if (key == sym_fixed ) return _get(obj, Closure,fixed) ? sym_t : nil; |
|
|
|
o = pClosure; |
|
|
|
break; |
|
|
|
# endif |
|
|
|
case Object: { |
|
|
|
ssize_t ind = Object_find(obj, key); |
|
|
|
if (ind >= 0) return _get(obj, Object,properties)[ind].val; |
|
|
|
o = _getDelegate(obj); |
|
|
|
break; |
|
|
|
} |
|
|
|
} |
|
|
|
# undef makeCase |
|
|
|
# if !DELOPT |
|
|
|
if (key == prop_delegate) return o; // implicit delegate of atomic object |
|
|
|
# endif |
|
|
|
if (key == prop_delegate) return o; |
|
|
|
while (is(Object, o)) { |
|
|
|
ssize_t ind = Object_find(o, key); |
|
|
|
if (ind >= 0) return _get(o, Object,properties)[ind].val; |
|
|
|
o = _getDelegate(o); |
|
|
|
} |
|
|
|
# if DELOPT |
|
|
|
if (key == prop_delegate) { |
|
|
|
# define makeCase(NAME) case NAME: return p##NAME; |
|
|
|
switch (getType(obj)) { |
|
|
|
doTypes(makeCase); |
|
|
|
case Object: return _getDelegate(obj); |
|
|
|
} |
|
|
|
# undef makeCase |
|
|
|
} |
|
|
|
# endif |
|
|
|
fatal("%s.%s is undefined", storeString(obj, 0), storeString(key, 0)); |
|
|
|
return nil; |
|
|
|
} |
|
|
@ -586,6 +592,20 @@ oop setvar(oop obj, oop key, oop val) |
|
|
|
|
|
|
|
oop Object_put(oop obj, oop key, oop val) |
|
|
|
{ |
|
|
|
# if PRIMCLOSURE |
|
|
|
switch (getType(obj)) { |
|
|
|
case Lambda: |
|
|
|
if (key == sym_parameters ) { _set(obj, Lambda,parameters, val); return val; } |
|
|
|
if (key == sym_body ) { _set(obj, Lambda,body, val); return val; } |
|
|
|
break; |
|
|
|
case Closure: |
|
|
|
if (key == sym_fixed ) { _set(obj, Closure,fixed, nil != val); return val; } |
|
|
|
if (key == sym_function ) { _set(obj, Closure,function, val); return val; } |
|
|
|
if (key == sym_environment) { _set(obj, Closure,environment, val); return val; } |
|
|
|
default: |
|
|
|
break; |
|
|
|
} |
|
|
|
# endif |
|
|
|
ssize_t ind = Object_find(obj, key); |
|
|
|
struct property *kvs = _get(obj, Object,properties); |
|
|
|
if (ind < 0) { |
|
|
@ -723,8 +743,37 @@ oop printOn(oop buf, oop obj, int indent) |
|
|
|
break; |
|
|
|
} |
|
|
|
#if PRIMCLOSURE |
|
|
|
case Lambda: String_appendAll(buf, "<lambda>"); break; |
|
|
|
case Closure: String_appendAll(buf, "<closure>"); break; |
|
|
|
case Lambda: { |
|
|
|
String_appendAll(buf, "<<Lambda>>"); |
|
|
|
if (!indent) break; |
|
|
|
|
|
|
|
String_append(buf, '\n'); |
|
|
|
for (int j = indent; j--;) String_appendAll(buf, " | "); |
|
|
|
String_appendAll(buf, " body: "); |
|
|
|
printOn(buf, _get(obj, Lambda,body), indent+1); |
|
|
|
|
|
|
|
String_append(buf, '\n'); |
|
|
|
for (int j = indent; j--;) String_appendAll(buf, " | "); |
|
|
|
String_appendAll(buf, " parameters: "); |
|
|
|
printOn(buf, _get(obj, Lambda,parameters), indent+1); |
|
|
|
break; |
|
|
|
} |
|
|
|
case Closure: { |
|
|
|
String_appendAll(buf, "<<Closure>>"); |
|
|
|
if (!indent) break; |
|
|
|
|
|
|
|
String_append(buf, '\n'); |
|
|
|
for (int j = indent; j--;) String_appendAll(buf, " | "); |
|
|
|
String_appendAll(buf, " environment: "); |
|
|
|
printOn(buf, _get(obj, Closure,environment), indent+1); |
|
|
|
|
|
|
|
String_append(buf, '\n'); |
|
|
|
for (int j = indent; j--;) String_appendAll(buf, " | "); |
|
|
|
String_appendAll(buf, " function: "); |
|
|
|
printOn(buf, _get(obj, Closure,function), indent+1); |
|
|
|
break; |
|
|
|
break; |
|
|
|
} |
|
|
|
#endif |
|
|
|
case Object: { |
|
|
|
int level = 0; |
|
|
@ -1074,6 +1123,17 @@ oop GetArray_eval(oop exp, oop env) |
|
|
|
default: fatal("[]: %s is not indexable", storeString(obj, 0)); |
|
|
|
} |
|
|
|
} |
|
|
|
if (getType(ind) == Object) { |
|
|
|
switch (getType(obj)) { |
|
|
|
case String: { |
|
|
|
int start = integerValue(eval(Object_get(ind, sym_start), env), "[..]"); |
|
|
|
int end = integerValue(eval(Object_get(ind, sym_end ), env), "[..]"); |
|
|
|
oop slice = newStringLen(String_aref(obj, start), end - start); |
|
|
|
return slice; |
|
|
|
} |
|
|
|
default: fatal("[]: %s is not range - indexable", storeString(obj, 0)); |
|
|
|
} |
|
|
|
} |
|
|
|
if (!is(Object, obj)) fatal("[]: %s is not an object", storeString(obj, 0)); |
|
|
|
return Object_getLocal(obj, ind); |
|
|
|
} |
|
|
@ -1123,6 +1183,25 @@ void SetArray_codeOn(oop exp, oop str, oop env) |
|
|
|
codeOn(str, Object_get(exp, sym_value), 0); |
|
|
|
} |
|
|
|
|
|
|
|
oop newRange(oop start, oop end) { |
|
|
|
oop o = new(pRange); |
|
|
|
Object_put(o, sym_start, start); |
|
|
|
Object_put(o, sym_end, end); |
|
|
|
return o; |
|
|
|
} |
|
|
|
|
|
|
|
oop Range_eval(oop exp, oop env) |
|
|
|
{ |
|
|
|
return exp; |
|
|
|
} |
|
|
|
|
|
|
|
void Range_codeOn(oop exp, oop str, oop env) |
|
|
|
{ |
|
|
|
codeOn(str, Object_get(exp, sym_start), 0); |
|
|
|
String_appendAll(str, ".."); |
|
|
|
codeOn(str, Object_get(exp, sym_end), 0); |
|
|
|
} |
|
|
|
|
|
|
|
oop newCall(oop function, oop arguments) |
|
|
|
{ |
|
|
|
oop o = new(pCall); |
|
|
@ -1144,7 +1223,11 @@ oop newApply(oop function, oop arguments) |
|
|
|
|
|
|
|
int isFixed(oop func) |
|
|
|
{ |
|
|
|
# if PRIMCLOSURE |
|
|
|
return is(Closure, func) && _get(func, Closure,fixed); |
|
|
|
# else |
|
|
|
return Object_getLocal(func, sym_fixed) != nil; |
|
|
|
# endif |
|
|
|
} |
|
|
|
|
|
|
|
oop Call_eval(oop exp, oop env) |
|
|
@ -1220,6 +1303,19 @@ oop newLambda(oop parameters, oop body) |
|
|
|
return o; |
|
|
|
} |
|
|
|
|
|
|
|
oop newClosure(oop function, oop environment) |
|
|
|
{ |
|
|
|
oop o = new(pClosure); |
|
|
|
Object_put(o, sym_function , function ); |
|
|
|
Object_put(o, sym_environment, environment); |
|
|
|
return o; |
|
|
|
} |
|
|
|
|
|
|
|
int isClosure(oop obj) |
|
|
|
{ |
|
|
|
return is(Object, obj) && pClosure == _getDelegate(obj); |
|
|
|
} |
|
|
|
|
|
|
|
oop Lambda_eval(oop exp, oop env) |
|
|
|
{ |
|
|
|
return newClosure(exp, env); |
|
|
@ -1231,14 +1327,6 @@ void Lambda_codeOn(oop exp, oop str, oop env) |
|
|
|
codeBlockOn(str, Object_get(exp, sym_body)); |
|
|
|
} |
|
|
|
|
|
|
|
oop newClosure(oop lambda, oop environment) |
|
|
|
{ |
|
|
|
oop o = new(pClosure); |
|
|
|
Object_put(o, sym_lambda , lambda ); |
|
|
|
Object_put(o, sym_environment, environment); |
|
|
|
return o; |
|
|
|
} |
|
|
|
|
|
|
|
oop Closure_eval(oop exp, oop env) |
|
|
|
{ |
|
|
|
return exp; |
|
|
@ -1445,9 +1533,10 @@ oop quasiclone(oop exp, oop env) |
|
|
|
struct property *kvs = _get(exp, Object,properties); |
|
|
|
int psize = _get(exp, Object,psize); |
|
|
|
for (int i = 0; i < psize; ++i) |
|
|
|
Object_put(clone, kvs[i].key, quasiclone(kvs[i].val, env)); |
|
|
|
if (kvs[i].key != prop_delegate) |
|
|
|
Object_put(clone, kvs[i].key, quasiclone(kvs[i].val, env)); |
|
|
|
oop delegate = _getDelegate(exp); |
|
|
|
if (nil != delegate) |
|
|
|
if (nil != delegate) // always shallow copied |
|
|
|
Object_put(clone, prop_delegate, delegate); |
|
|
|
return clone; |
|
|
|
} |
|
|
@ -1873,10 +1962,13 @@ sum = l:prod ( PLUS r:prod { l = newBinop(opAdd, l, r) } |
|
|
|
| MINUS r:prod { l = newBinop(opSub, l, r) } |
|
|
|
)* { $$ = l } |
|
|
|
|
|
|
|
prod = l:prefix ( STAR r:prefix { l = newBinop(opMul, l, r) } |
|
|
|
| SLASH r:prefix { l = newBinop(opDiv, l, r) } |
|
|
|
| PCENT r:prefix { l = newBinop(opMod, l, r) } |
|
|
|
)* { $$ = l } |
|
|
|
prod = l:range ( STAR r:range { l = newBinop(opMul, l, r) } |
|
|
|
| SLASH r:range { l = newBinop(opDiv, l, r) } |
|
|
|
| PCENT r:range { l = newBinop(opMod, l, r) } |
|
|
|
) * { $$ = l } |
|
|
|
|
|
|
|
range = i1:prefix ( DOTDOT i2:prefix { i1 = newRange(i1, i2) } |
|
|
|
) ? { $$ = i1 } |
|
|
|
|
|
|
|
prefix = PLING p:prefix { $$ = newUnyop(opNot, p) } |
|
|
|
| MINUS p:prefix { $$ = newUnyop(opNeg, p) } |
|
|
@ -1931,8 +2023,7 @@ number = "-" u:unsign { $$ = neg(u) } |
|
|
|
| "+" n:number { $$ = u } |
|
|
|
| u:unsign { $$ = u } |
|
|
|
|
|
|
|
unsign = < DIGIT+ '.' DIGIT* EXP? > - { $$ = newFloat(strtod(yytext, 0)) } |
|
|
|
| < DIGIT* '.' DIGIT+ EXP? > - { $$ = newFloat(strtod(yytext, 0)) } |
|
|
|
unsign = < DIGIT* '.' DIGIT+ EXP? > - { $$ = newFloat(strtod(yytext, 0)) } |
|
|
|
| "0" [bB] < BIGIT+ > - { $$ = newInteger(strtol(yytext, 0, 2)) } |
|
|
|
| "0" [xX] < HIGIT+ > - { $$ = newInteger(strtol(yytext, 0, 16)) } |
|
|
|
| "0" < OIGIT* > - { $$ = newInteger(strtol(yytext, 0, 8)) } |
|
|
@ -1970,40 +2061,41 @@ IN = "in" !ALNUM - |
|
|
|
FROM = "from" !ALNUM - |
|
|
|
TO = "to" !ALNUM - |
|
|
|
|
|
|
|
BQUOTE = "`" - |
|
|
|
COMMAT = "@" - |
|
|
|
HASH = "#" - |
|
|
|
SEMI = ";" - |
|
|
|
ASSIGN = "=" ![=] - |
|
|
|
COMMA = "," - |
|
|
|
COLON = ":" - |
|
|
|
LPAREN = "(" - |
|
|
|
RPAREN = ")" - |
|
|
|
LBRAK = "[" - |
|
|
|
RBRAK = "]" - |
|
|
|
LBRACE = "{" - |
|
|
|
RBRACE = "}" - |
|
|
|
BARBAR = "||" ![=] - |
|
|
|
ANDAND = "&&" ![=] - |
|
|
|
OR = "|" ![|=] - |
|
|
|
XOR = "^" ![=] - |
|
|
|
AND = "&" ![&=] - |
|
|
|
EQ = "==" - |
|
|
|
NOTEQ = "!=" - |
|
|
|
LESS = "<" ![<=] - |
|
|
|
LESSEQ = "<=" - |
|
|
|
GRTREQ = ">=" - |
|
|
|
GRTR = ">" ![=] - |
|
|
|
SHL = "<<" ![=] - |
|
|
|
SHR = ">>" ![=] - |
|
|
|
PLUS = "+" ![+=] - |
|
|
|
MINUS = "-" ![-=] - |
|
|
|
STAR = "*" ![=] - |
|
|
|
SLASH = "/" ![/=] - |
|
|
|
PCENT = "%" ![*=] - |
|
|
|
DOT = "." - |
|
|
|
PLING = "!" ![=] - |
|
|
|
TILDE = "~" - |
|
|
|
BQUOTE = "`" - |
|
|
|
COMMAT = "@" - |
|
|
|
HASH = "#" - |
|
|
|
SEMI = ";" - |
|
|
|
ASSIGN = "=" ![=] - |
|
|
|
COMMA = "," - |
|
|
|
COLON = ":" - |
|
|
|
LPAREN = "(" - |
|
|
|
RPAREN = ")" - |
|
|
|
LBRAK = "[" - |
|
|
|
RBRAK = "]" - |
|
|
|
LBRACE = "{" - |
|
|
|
RBRACE = "}" - |
|
|
|
BARBAR = "||" ![=] - |
|
|
|
ANDAND = "&&" ![=] - |
|
|
|
OR = "|" ![|=] - |
|
|
|
XOR = "^" ![=] - |
|
|
|
AND = "&" ![&=] - |
|
|
|
EQ = "==" - |
|
|
|
NOTEQ = "!=" - |
|
|
|
LESS = "<" ![<=] - |
|
|
|
LESSEQ = "<=" - |
|
|
|
GRTREQ = ">=" - |
|
|
|
GRTR = ">" ![=] - |
|
|
|
SHL = "<<" ![=] - |
|
|
|
SHR = ">>" ![=] - |
|
|
|
PLUS = "+" ![+=] - |
|
|
|
MINUS = "-" ![-=] - |
|
|
|
STAR = "*" ![=] - |
|
|
|
SLASH = "/" ![/=] - |
|
|
|
PCENT = "%" ![*=] - |
|
|
|
DOT = "." ![.] - |
|
|
|
DOTDOT = ".." - |
|
|
|
PLING = "!" ![=] - |
|
|
|
TILDE = "~" - |
|
|
|
|
|
|
|
%%; |
|
|
|
|
|
|
@ -2031,14 +2123,14 @@ oop apply(oop func, oop self, oop args, oop env) |
|
|
|
#if PRIMCLOSURE |
|
|
|
if (Closure != functype) |
|
|
|
fatal("cannot %s %s", (nil == self ? "call" : "invoke"), storeString(func, 0)); |
|
|
|
oop lambda = _get(func, Closure,lambda); |
|
|
|
oop lambda = _get(func, Closure,function); |
|
|
|
oop environment = _get(func, Closure,environment); |
|
|
|
oop parameters = _get(lambda, Lambda,parameters); |
|
|
|
oop body = _get(lambda, Lambda,body); |
|
|
|
#else |
|
|
|
if (Object != functype || pClosure != _getDelegate(func)) |
|
|
|
fatal("cannot %s %s", (nil == self ? "call" : "invoke"), storeString(func, 0)); |
|
|
|
oop lambda = Object_get(func, sym_lambda); |
|
|
|
oop lambda = Object_get(func, sym_function); |
|
|
|
oop environment = Object_get(func, sym_environment); |
|
|
|
oop parameters = Object_get(lambda, sym_parameters); |
|
|
|
oop body = Object_get(lambda, sym_body); |
|
|
@ -2091,20 +2183,22 @@ enum typecode getTypecode(oop exp) |
|
|
|
return NAME##_eval(exp, env); \ |
|
|
|
} |
|
|
|
|
|
|
|
doProtos(defineEval) |
|
|
|
|
|
|
|
#undef defineEval |
|
|
|
|
|
|
|
#endif // !TYPECODES |
|
|
|
|
|
|
|
#define defineCodeOn(NAME) \ |
|
|
|
static inline oop prim_##NAME##_codeOn(oop func, oop exp, oop args, oop env) { \ |
|
|
|
NAME##_codeOn(exp, getArgType(args, 0, String, #NAME".codeOn"), env); \ |
|
|
|
return exp; \ |
|
|
|
} \ |
|
|
|
|
|
|
|
doProtos(defineEval) |
|
|
|
doProtos(defineCodeOn) |
|
|
|
|
|
|
|
#undef defineEval |
|
|
|
#undef defineCodeOn |
|
|
|
|
|
|
|
#endif // !TYPECODES |
|
|
|
|
|
|
|
static inline oop evalobj(oop exp, oop env) |
|
|
|
{ |
|
|
|
# if !TYPECODES |
|
|
@ -2117,7 +2211,7 @@ static inline oop evalobj(oop exp, oop env) |
|
|
|
|
|
|
|
enum typecode type = getTypecode(exp); |
|
|
|
|
|
|
|
# define defineEval(NAME) case t##NAME: NAME##_eval(exp, env); break; |
|
|
|
# define defineEval(NAME) case t##NAME: return NAME##_eval(exp, env); |
|
|
|
switch (type) { |
|
|
|
doProtos(defineEval); |
|
|
|
} |
|
|
@ -2196,13 +2290,31 @@ oop prim_length(oop func, oop self, oop args, oop env) |
|
|
|
oop prim_keys(oop func, oop self, oop args, oop env) |
|
|
|
{ |
|
|
|
oop keys = new(pObject); |
|
|
|
if (is(Object, self)) { |
|
|
|
int size = _get(self, Object,psize); |
|
|
|
struct property *kvs = _get(self, Object,properties); |
|
|
|
# if DELOPT |
|
|
|
if (nil != _getDelegate(self)) Object_push(keys, prop_delegate); |
|
|
|
# if DELOPT |
|
|
|
if (nil != _getDelegate(self)) Object_push(keys, prop_delegate); |
|
|
|
# endif |
|
|
|
switch (getType(self)) { |
|
|
|
case Undefined: case Integer: case Float: case String: case Symbol: case Primitive: |
|
|
|
break; |
|
|
|
case Object: { |
|
|
|
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); |
|
|
|
break; |
|
|
|
} |
|
|
|
# if PRIMCLOSURE |
|
|
|
case Lambda: { |
|
|
|
Object_push(keys, sym_parameters); |
|
|
|
Object_push(keys, sym_body); |
|
|
|
break; |
|
|
|
} |
|
|
|
case Closure: { |
|
|
|
Object_push(keys, sym_fixed); |
|
|
|
Object_push(keys, sym_lambda); |
|
|
|
Object_push(keys, sym_environment); |
|
|
|
break; |
|
|
|
} |
|
|
|
# endif |
|
|
|
for (int i = 0; i < size; ++i) Object_push(keys, kvs[i].key); |
|
|
|
} |
|
|
|
return keys; |
|
|
|
} |
|
|
@ -2212,37 +2324,16 @@ oop prim_env(oop func, oop self, oop args, oop env) |
|
|
|
return env; |
|
|
|
} |
|
|
|
|
|
|
|
oop prim_makeForm(oop func, oop self, oop args, oop env) |
|
|
|
oop prim_eval(oop func, oop self, oop args, oop env) |
|
|
|
{ |
|
|
|
int argc = _get(args, Object,isize); |
|
|
|
oop *indexed = _get(args, Object,indexed); |
|
|
|
oop result = nil; |
|
|
|
for (int i = 0; i < argc; ++i) { |
|
|
|
result = indexed[i]; |
|
|
|
if (!is(Closure, result)) fatal("makeForm: argument must be closure"); |
|
|
|
_set(result, Closure,fixed, 1); |
|
|
|
} |
|
|
|
return result; |
|
|
|
} |
|
|
|
|
|
|
|
oop prim_makeMacro(oop func, oop self, oop args, oop env) |
|
|
|
{ |
|
|
|
int argc = _get(args, Object,isize); |
|
|
|
oop *indexed = _get(args, Object,indexed); |
|
|
|
oop result = nil; |
|
|
|
for (int i = 0; i < argc; ++i) { |
|
|
|
result = indexed[i]; |
|
|
|
if (!is(Closure, result)) fatal("makeForm: argument must be closure"); |
|
|
|
_set(result, Closure,fixed, 1); |
|
|
|
if (nil != Object_getLocal(args, sym_env)) { |
|
|
|
env = Object_getLocal(args, sym_env); |
|
|
|
} |
|
|
|
return result; |
|
|
|
} |
|
|
|
|
|
|
|
oop prim_eval(oop func, oop self, oop args, oop env) |
|
|
|
{ |
|
|
|
int argc = _get(args, Object,isize); |
|
|
|
oop *indexed = _get(args, Object,indexed); |
|
|
|
oop result = nil; |
|
|
|
for (int i = 0; i < argc; ++i) result = eval(indexed[i], env); |
|
|
|
return result; |
|
|
|
} |
|
|
@ -2439,11 +2530,16 @@ int main(int argc, char **argv) |
|
|
|
# undef defineProto |
|
|
|
|
|
|
|
#if TYPECODES |
|
|
|
|
|
|
|
Object_put(pObject, prop_eval, newPrimitive(prim_env)); // inherited by all objects |
|
|
|
|
|
|
|
# define defineEvaluator(NAME) \ |
|
|
|
_set(intern(#NAME), Symbol,typecode, t##NAME); |
|
|
|
#else // !TYPECODES |
|
|
|
|
|
|
|
# define defineEvaluator(NAME) \ |
|
|
|
Object_put(p##NAME, prop_eval, newPrimitive(prim_##NAME##_eval)); |
|
|
|
|
|
|
|
#endif // !TYPECODES |
|
|
|
|
|
|
|
doProtos(defineEvaluator); |
|
|
@ -2460,7 +2556,6 @@ int main(int argc, char **argv) |
|
|
|
macros = Object_put(pSymbol, intern("macros"), new(pObject)); |
|
|
|
|
|
|
|
_set(intern("__env__" ), Symbol,value, newPrimitive(prim_env)); |
|
|
|
_set(intern("makeForm" ), Symbol,value, newPrimitive(prim_makeForm)); |
|
|
|
_set(intern("eval" ), Symbol,value, newPrimitive(prim_eval)); |
|
|
|
_set(intern("print" ), Symbol,value, newPrimitive(prim_print)); |
|
|
|
_set(intern("codeString" ), Symbol,value, newPrimitive(prim_codeString)); |
|
|
|