diff --git a/minproto.leg b/minproto.leg index 3063401..6fe24b6 100644 --- a/minproto.leg +++ b/minproto.leg @@ -1,6 +1,6 @@ # minproto.leg -- minimal prototype langauge for semantic experiments # -# last edited: 2024-05-12 07:57:37 by piumarta on zora +# last edited: 2024-05-14 05:10:06 by piumarta on m1mbp %{ ; @@ -64,11 +64,11 @@ typedef union object *oop; #if PRIMCLOSURE #define doTypes(_) \ - _(Undefined) _(Integer) _(Float) _(String) _(Symbol) _(Primitive) \ - _(Lambda) _(Closure) + _(Undefined) _(Integer) _(Float) _(String) _(Symbol) _(Primitive) \ + _(Lambda) _(Closure) #else #define doTypes(_) \ - _(Undefined) _(Integer) _(Float) _(String) _(Symbol) _(Primitive) + _(Undefined) _(Integer) _(Float) _(String) _(Symbol) _(Primitive) #endif #define makeType(X) X, @@ -81,35 +81,39 @@ char *typeNames[] = { doTypes(makeType) makeType(Object) }; typedef oop (*prim_t)(oop func, oop self, oop args, oop env); +oop codeOn(oop buf, oop obj, int indent); +oop storeOn(oop buf, oop obj, int indent); +oop printOn(oop buf, oop obj, int indent); + #if TAGS # define TAGBITS 2 # define TAGMASK 3 # define TAGINT Integer // 1 -# define TAGFLT Float // 2 +# define TAGFLT Float // 2 #endif #if PRIMCLOSURE -#define doProtos(_) _(Object) _(GetVar) _(SetVar) _(GetProp) _(SetProp) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Continue) _(Break) _(Return) _(Binop) _(Unyop) _(Let) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) +#define doProtos(_) _(Object) _(RefVar) _(GetVar) _(SetVar) _(RefProp) _(GetProp) _(SetProp) _(RefArray) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Continue) _(Break) _(Return) _(Binop) _(Unyop) _(Let) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) #else -#define doProtos(_) _(Object) _(GetVar) _(SetVar) _(GetProp) _(SetProp) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Continue) _(Break) _(Return) _(Binop) _(Unyop) _(Let) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) _(Lambda) _(Closure) +#define doProtos(_) _(Object) _(RefVar) _(GetVar) _(SetVar) _(RefProp) _(GetProp) _(SetProp) _(RefArray) _(GetArray) _(SetArray) _(Call) _(Invoke) _(Continue) _(Break) _(Return) _(Binop) _(Unyop) _(Let) _(If) _(While) _(Block) _(For) _(ForIn) _(ForFromTo) _(Literal) _(Lambda) _(Closure) #endif -#define declareProto(NAME) oop p##NAME = 0; +#define declareProto(NAME) oop p##NAME = 0; doProtos(declareProto); -#undef declareProto +#undef declareProto #if TYPECODES -#define declareTypecode(NAME) t##NAME, +#define declareTypecode(NAME) t##NAME, enum typecode { UNDEFINED_TYPECODE, doProtos(declareTypecode) }; -#undef declareTypecode +#undef declareTypecode #endif // TYPECODES -#define makeProto(NAME) oop p##NAME = 0; +#define makeProto(NAME) oop p##NAME = 0; doTypes(makeProto); #undef makeProto @@ -137,13 +141,13 @@ enum { }; // passed to longjmp, returned from setjmp struct NLR { - int ntrace; + int ntrace; jmp_buf env; }; struct NLR *nlrs = 0; -int nnlrs = 0; +int nnlrs = 0; int maxnlrs = 0; oop valnlr = 0; @@ -163,30 +167,30 @@ oop valnlr = 0; #endif -struct property { oop key, val; }; +struct property { oop key, val; }; -struct Integer { enum type type; long _value; }; -struct Float { enum type type; double _value; }; -struct String { enum type type; int length; char *value; }; +struct Integer { enum type type; long _value; }; +struct Float { enum type type; double _value; }; +struct String { enum type type; int length; char *value; }; #if TYPECODES -struct Symbol { enum type type; char *name; oop value; enum typecode typecode; }; +struct Symbol { enum type type; char *name; oop value; enum typecode typecode; }; #else // !TYPECODES -struct Symbol { enum type type; char *name; oop value; }; +struct Symbol { enum type type; char *name; oop value; }; #endif 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 function, environment; }; +struct Lambda { enum type type; oop parameters, body; }; +struct Closure { enum type type; oop fixed, function, environment; }; #endif -struct Object { enum type type; int isize, icap, psize; -# if DELOPT +struct Object { enum type type; int isize, icap, psize; +# if DELOPT oop delegate; -# endif +# endif oop *indexed; struct property *properties; }; union object { - enum type type; + enum type type; struct Integer Integer; struct Float Float; struct String String; @@ -219,7 +223,7 @@ char *getTypeName(oop obj) return typeNames[type]; } -int is(enum type type, oop obj) { return type == getType(obj); } +int is(enum type type, oop obj) { return type == getType(obj); } oop _checkType(oop obj, enum type type, char *file, int line) { @@ -309,7 +313,7 @@ double floatValue(oop obj, char *op) oop newStringLen(char *value, int length) { - oop obj = make(String); + oop obj = make(String); char *str = xmallocAtomic(length+1); memcpy(str, value, length); str[length] = 0; @@ -325,7 +329,7 @@ oop newString(char *value) int digitValue(int digit, int base) { - if ('a' <= digit && digit <= 'z') digit -= 'a' - 10; + if ('a' <= digit && digit <= 'z') digit -= 'a' - 10; else if ('A' <= digit && digit <= 'Z') digit -= 'A' - 10; else if (digit < '0' || digit > '9') return -1; return (digit < base) ? digit : -1; @@ -334,7 +338,7 @@ int digitValue(int digit, int base) int readCharValue(char **stringp, int base, int limit) { char *string = *stringp; - int value = 0, d = 0; + int value = 0, d = 0; while (limit-- && *string && (d = digitValue(*string, base)) >= 0) { ++string; value = value * base + d; @@ -343,8 +347,8 @@ int readCharValue(char **stringp, int base, int limit) return value; } -int String_length(oop str) { return get(str, String,length); } -oop String_reset (oop str) { set(str, String,length, 0); return str; } +int String_length(oop str) { return get(str, String,length); } +oop String_reset (oop str) { set(str, String,length, 0); return str; } void String_clear(oop str) { @@ -354,7 +358,7 @@ void String_clear(oop str) oop String_append(oop str, int c) { - int length = get(str, String,length); + int length = get(str, String,length); char *value = get(str, String,value); value = xrealloc(value, length + 1); set(str, String,value, value); @@ -365,7 +369,7 @@ oop String_append(oop str, int c) oop String_appendAllLen(oop str, char *s, int len) { - int length = get(str, String,length); + int length = get(str, String,length); char *value = get(str, String,value); value = xrealloc(value, length + len); memcpy(value + length, s, len); @@ -382,7 +386,7 @@ oop String_appendAll(oop str, char *s) oop String_format(oop str, char *fmt, ...) { size_t len = 0, cap = 16; - int length = get(str, String,length); + int length = get(str, String,length); char *value = get(str, String,value); for (;;) { value = xrealloc(value, length + cap); @@ -426,7 +430,7 @@ oop newStringEscaped(char *string) case 'X' : case 'x' : c = readCharValue(&string, 16, -1); break; case '0' : c = readCharValue(&string, 8, 3); break; - default : fatal("illegal character escape sequence"); break; + default : fatal("illegal character escape sequence"); break; } } String_append(buf, c); @@ -454,10 +458,19 @@ char *stringValue(oop obj, char *who) return 0; } +int stringLength(oop obj, char *who) +{ + int type = getType(obj); + if (type == String) return _get(obj, String,length); + if (type == Symbol) return strlen(_get(obj, Symbol,name)); + fatal("%s: non-string operand", who); + return 0; +} + oop newPrimitive(prim_t function) { oop obj = make(Primitive); - _set(obj, Primitive,name, 0); + _set(obj, Primitive,name, 0); _set(obj, Primitive,function, function); return obj; } @@ -468,14 +481,14 @@ oop newLambda(oop parameters, oop body) { oop obj = make(Lambda); _set(obj, Lambda,parameters, parameters); - _set(obj, Lambda,body, body); + _set(obj, Lambda,body, body); return obj; } oop newClosure(oop function, oop environment) { oop obj = make(Closure); - _set(obj, Closure,function, function); + _set(obj, Closure,function, function); _set(obj, Closure,environment, environment); return obj; } @@ -484,7 +497,7 @@ int isClosure(oop obj) { return is(Closure, obj); } #endif -oop macros = 0; +oop macros = 0; oop *symbols = 0; size_t nsymbols = 0; @@ -495,9 +508,9 @@ oop intern(char *name) ssize_t mid = (lo + hi) / 2; oop sym = symbols[mid]; int cmp = strcmp(name, _get(sym, Symbol,name)); - if (cmp < 0) hi = mid - 1; + if (cmp < 0) hi = mid - 1; else if (cmp > 0) lo = mid + 1; - else return sym; + else return sym; } symbols = xrealloc(symbols, sizeof(*symbols) * ++nsymbols); memmove(symbols + lo + 1, symbols + lo, sizeof(*symbols) * (nsymbols - 1 - lo)); @@ -526,7 +539,7 @@ oop Object_push(oop obj, oop val) if (size >= cap) { cap = cap ? cap * 2 : 4; indexed = xrealloc(indexed, sizeof(*indexed) * cap); - _set(obj, Object,icap, cap); + _set(obj, Object,icap, cap); _set(obj, Object,indexed, indexed); } indexed[size++] = val; @@ -539,7 +552,7 @@ oop Object_pop(oop obj) size_t size = get(obj, Object,isize); if (!size) fatal("pop: object is empty"); oop *indexed = _get(obj, Object,indexed); - oop result = indexed[--size]; + oop result = indexed[--size]; _set(obj, Object,isize, size); return result; } @@ -553,13 +566,21 @@ ssize_t Object_find(oop obj, oop key) while (lo <= hi) { ssize_t mid = (lo + hi) / 2; oop midkey = kvs[mid].key; - if (key < midkey) hi = mid - 1; + if (key < midkey) hi = mid - 1; else if (key > midkey) lo = mid + 1; - else return mid; + else return mid; } return -1 - lo; } +oop *Object_refLocal(oop obj, oop key) +{ + if (!is(Object, obj)) return 0; + ssize_t ind = Object_find(obj, key); + if (ind >= 0) return &_get(obj, Object,properties)[ind].val; + return 0; +} + oop Object_getLocal(oop obj, oop key) { if (!is(Object, obj)) return nil; @@ -570,34 +591,75 @@ oop Object_getLocal(oop obj, oop key) #if DELOPT # define _getDelegate(OBJ) _get(OBJ, Object,delegate) -# define _setDelegate(OBJ, VAL) _set(OBJ, Object,delegate, VAL) +# define _setDelegate(OBJ, VAL) _set(OBJ, Object,delegate, VAL) #else # define _getDelegate(OBJ) Object_getLocal(OBJ, prop_delegate) -# define _setDelegate(OBJ, VAL) Object_put(OBJ, prop_delegate, VAL) +# define _setDelegate(OBJ, VAL) Object_put(OBJ, prop_delegate, VAL) #endif char *storeString(oop obj, int indent); +oop *Object_ref(oop obj, oop key) +{ + oop o; + switch (getType(obj)) { + 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); + 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); + if (nil == o) o = pObject; + break; + } + } + if (key == prop_delegate) fatal("__delegate__ is inaccessible"); + while (is(Object, o)) { + ssize_t ind = Object_find(o, key); + if (ind >= 0) return &_get(o, Object,properties)[ind].val; + o = _getDelegate(o); + } + fatal("undefined property: %s.%s", storeString(obj, 0), storeString(key, 0)); + return 0; +} + oop Object_get(oop obj, oop key) { oop o; switch (getType(obj)) { - 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; + 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 ); + 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; + if (key == sym_fixed ) return _get(obj, Closure,fixed ); o = pClosure; break; # endif @@ -619,6 +681,18 @@ oop Object_get(oop obj, oop key) return nil; } +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); + } + oop *ref = &_get(key, Symbol,value); // asserts is(Symbol,key) + if (UNDEFINED == *ref) fatal("undefined variable: %s", storeString(key, 0)); + return ref; +} + oop getvar(oop obj, oop key) { while (is(Object, obj)) { @@ -647,12 +721,12 @@ oop Object_put(oop obj, oop key, oop val) 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; } + 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; } + if (key == sym_fixed ) { _set(obj, Closure,fixed, 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; } @@ -667,25 +741,25 @@ oop Object_put(oop obj, oop key, oop val) ind = -1 - ind; assert(0 <= ind && ind <= size); kvs = xrealloc(kvs, sizeof(*kvs) * ++size); _set(obj, Object,properties, kvs); - _set(obj, Object,psize, size); + _set(obj, Object,psize, size); memmove(kvs + ind + 1, kvs + ind, sizeof(*kvs) * (size - 1 - ind)); kvs[ind].key = key; } assert(ind < _get(obj, Object,psize)); - assert(kvs[ind].key == key); + assert(kvs[ind].key == key); return kvs[ind].val = val; } oop new(oop delegate) { oop obj = make(Object); - _set(obj, Object,isize, 0); - _set(obj, Object,icap, 0); - _set(obj, Object,indexed, 0); + _set(obj, Object,isize, 0); + _set(obj, Object,icap, 0); + _set(obj, Object,indexed, 0); # if DELOPT - _set(obj, Object,psize, 0); + _set(obj, Object,psize, 0); _setDelegate(obj, delegate); # else - _set(obj, Object,psize, 1); + _set(obj, Object,psize, 1); _set(obj, Object,properties, xmalloc(sizeof(struct property))) [0] = (struct property) { prop_delegate, delegate }; # endif @@ -695,10 +769,10 @@ oop new(oop delegate) oop newObjectWith(int isize, oop *indexed, int psize, struct property *properties) { oop obj = make(Object); - _set(obj, Object,isize, isize); - _set(obj, Object,icap, isize); - _set(obj, Object,psize, psize); - _set(obj, Object,indexed, indexed); + _set(obj, Object,isize, isize); + _set(obj, Object,icap, isize); + _set(obj, Object,psize, psize); + _set(obj, Object,indexed, indexed); _set(obj, Object,properties, properties); # if DELOPT _setDelegate(obj, nil); @@ -708,17 +782,13 @@ oop newObjectWith(int isize, oop *indexed, int psize, struct property *propertie oop apply(oop func, oop self, oop args, oop env); -oop codeOn(oop buf, oop obj, int indent); -oop storeOn(oop buf, oop obj, int indent); -oop printOn(oop buf, oop obj, int indent); - void codeParametersOn(oop str, oop object, char *begin, char *end) { String_appendAll(str, begin); oop *indexed = _get(object, Object,indexed); - int isize = _get(object, Object,isize); - int i; - for (i = 0; i < isize; ++i) { + int isize = _get(object, Object,isize); + int i; + for (i = 0; i < isize; ++i) { if (i) String_appendAll(str, ", "); printOn(str, indexed[i], 0); } @@ -729,9 +799,9 @@ void codeBlockOn(oop str, oop object) { String_appendAll(str, "{"); oop *indexed = _get(object, Object,indexed); - int isize = _get(object, Object,isize); - int i; - for (i = 0; i < isize; ++i) { + int isize = _get(object, Object,isize); + int i; + for (i = 0; i < isize; ++i) { if (i) String_appendAll(str, "; "); else String_appendAll(str, " "); codeOn(str, indexed[i], 0); } @@ -742,15 +812,15 @@ void codeBlockOn(oop str, oop object) oop codeOn(oop str, oop obj, int indent) { switch (getType(obj)) { - case Undefined: String_appendAll(str, "nil"); break; + case Undefined: String_appendAll(str, "nil"); break; case Integer: String_format(str, "%ld", _integerValue(obj)); break; case Float: String_format(str, "%f" , _floatValue(obj)); break; - case String: storeOn(str, obj, 0); break; + case String: storeOn(str, obj, 0); break; case Symbol: String_format(str, "#%s", _get(obj, Symbol,name)); break; case Primitive: { String_appendAll(str, "'); break; } @@ -767,7 +837,7 @@ oop codeOn(oop str, oop obj, int indent) #endif case Object: { oop evaluator = Object_get(obj, prop_codeon); - oop args = new(pObject); + oop args = new(pObject); Object_push(args, str); apply(evaluator, obj, args, nil); break; @@ -781,7 +851,7 @@ oop codeOn(oop str, oop obj, int indent) oop printOn(oop buf, oop obj, int indent) { switch (getType(obj)) { - case Undefined: String_appendAll(buf, "nil"); break; + case Undefined: String_appendAll(buf, "nil"); break; case Integer: String_format(buf, "%ld", _integerValue(obj)); break; case Float: String_format(buf, "%f" , _floatValue(obj)); break; case String: String_format(buf, "%.*s", (int)_get(obj, String,length), _get(obj, String,value)); break; @@ -789,7 +859,7 @@ oop printOn(oop buf, oop obj, int indent) case Primitive: { String_appendAll(buf, "'); break; } @@ -799,12 +869,12 @@ oop printOn(oop buf, oop obj, int indent) if (!indent) break; String_append(buf, '\n'); - for (int j = indent; j--;) String_appendAll(buf, " | "); + 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, " | "); + for (int j = indent; j--;) String_appendAll(buf, " | "); String_appendAll(buf, " parameters: "); printOn(buf, _get(obj, Lambda,parameters), indent+1); break; @@ -814,12 +884,12 @@ oop printOn(oop buf, oop obj, int indent) if (!indent) break; String_append(buf, '\n'); - for (int j = indent; j--;) String_appendAll(buf, " | "); + 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, " | "); + for (int j = indent; j--;) String_appendAll(buf, " | "); String_appendAll(buf, " function: "); printOn(buf, _get(obj, Closure,function), indent+1); break; @@ -836,12 +906,12 @@ oop printOn(oop buf, oop obj, int indent) if (nil != name) break; proto = _getDelegate(proto); } while (is(Object, proto)); - for (int i = level; i--;) String_append(buf, '<'); + for (int i = level; i--;) String_append(buf, '<'); if (name != nil) printOn(buf, name, indent); else String_appendAll(buf, "?"); - for (int i = level; i--;) String_append(buf, '>'); + for (int i = level; i--;) String_append(buf, '>'); if (!indent) break; for (;;) { int psize = _get(obj, Object,psize); @@ -849,7 +919,7 @@ oop printOn(oop buf, oop obj, int indent) for (int i = 0; i < psize; ++i) { if (prop_delegate == props[i].key) continue; String_append(buf, '\n'); - for (int j = indent; j--;) String_appendAll(buf, " | "); + for (int j = indent; j--;) String_appendAll(buf, " | "); String_appendAll(buf, " "); printOn(buf, props[i].key, indent+1); String_appendAll(buf, ": "); @@ -859,7 +929,7 @@ oop printOn(oop buf, oop obj, int indent) oop *indexed = _get(obj, Object,indexed); for (int i = 0; i < isize; ++i) { String_append(buf, '\n'); - for (int j = indent; j--;) String_appendAll(buf, " | "); + for (int j = indent; j--;) String_appendAll(buf, " | "); String_format(buf, " %d: ", i); printOn(buf, indexed[i], indent+1); } @@ -884,7 +954,7 @@ oop storeOn(oop buf, oop obj, int indent) case String: { String_append(buf, '"'); char *str = _get(obj, String,value); - int len = _get(obj, String,length); + int len = _get(obj, String,length); for (int i = 0; i < len; ++i) { int c = str[i]; switch (c) { @@ -899,13 +969,35 @@ oop storeOn(oop buf, oop obj, int indent) case '\\': String_appendAll(buf, "\\\\"); break; default: if (c < ' ' || c > '~') String_format(buf, "\\%04o", c); - else String_append(buf, c); + else String_append(buf, c); break; } } String_append(buf, '"'); break; } + case Object: { + String_append(buf, '['); + oop *elts = _get(obj, Object,indexed); + int size = _get(obj, Object,isize); + int i = 0; + while (i < size) { + if (i) String_appendAll(buf, ", "); + codeOn(buf, elts[i], indent); + ++i; + } + 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); + String_appendAll(buf, ": "); + codeOn(buf, kvs[i].val, indent); + } + String_append(buf, ']'); + break; + } default: printOn(buf, obj, indent); } return buf; @@ -981,7 +1073,7 @@ void fatal(char *fmt, ...) va_end(ap); if (is(Object, trace)) { int w = 1 + log10(_get(trace, Object,isize)); - for (int i = _get(trace, Object,isize); i--;) { + for (int i = _get(trace, Object,isize); i--;) { printf("%*d: ", w, i); codeln(_get(trace, Object,indexed)[i], 1); } @@ -999,8 +1091,8 @@ void sigint(int sig) typedef struct Input { struct Input *next; char *text; - int size; - int position; + int size; + int position; } Input; Input *newInput(void) @@ -1041,6 +1133,29 @@ 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(oop *address) +{ + // top 7 bits of virtual addresses are guaranteed to be the same, + // at least until Apple decides to break that and call it a "feature" + intptr_t p = (intptr_t)address; + oop o = newInteger(p); assert(p == _integerValue(o)); + return o; +} + +oop RefVar_eval(oop exp, oop env) +{ + return mkptr(refvar(env, Object_get(exp, sym_name))); +} + +void RefVar_codeOn(oop exp, oop str, oop env) { printOn(str, Object_get(exp, sym_name), 0); } + oop newGetVar(oop name) { oop o = new(pGetVar); @@ -1062,7 +1177,7 @@ oop newSetVar(oop name, oop expr) oop SetVar_eval(oop exp, oop env) { - oop key = Object_get(exp, sym_name) ; + oop key = Object_get(exp, sym_name) ; oop val = eval(Object_get(exp, sym_expr), env); return setvar(env, key, val); } @@ -1074,6 +1189,28 @@ void SetVar_codeOn(oop exp, oop str, oop env) codeOn(str, Object_get(exp, sym_expr), 0); } +oop newRefProp(oop object, oop key) +{ + oop o = new(pRefProp); + Object_put(o, sym_object, object); + Object_put(o, sym_key , key ); + return o; +} + +oop RefProp_eval(oop exp, oop env) +{ + oop obj = eval(Object_get(exp, sym_object), env); + oop key = Object_get(exp, sym_key ) ; + return mkptr(Object_ref(obj, key)); +} + +void RefProp_codeOn(oop exp, oop str, oop env) +{ + codeOn(str, Object_get(exp, sym_object), 0); + String_appendAll(str, "."); + printOn(str, Object_get(exp, sym_key ), 0); +} + oop newGetProp(oop object, oop key) { oop o = new(pGetProp); @@ -1085,7 +1222,7 @@ oop newGetProp(oop object, oop key) oop GetProp_eval(oop exp, oop env) { oop obj = eval(Object_get(exp, sym_object), env); - oop key = Object_get(exp, sym_key ) ; + oop key = Object_get(exp, sym_key ) ; return Object_get(obj, key); } @@ -1108,7 +1245,7 @@ oop newSetProp(oop object, oop key, oop value) oop SetProp_eval(oop exp, oop env) { oop obj = eval(Object_get(exp, sym_object), env); - oop key = Object_get(exp, sym_key ) ; + oop key = Object_get(exp, sym_key ) ; oop val = eval(Object_get(exp, sym_value ), env); return Object_put(obj, key, val); } @@ -1130,14 +1267,6 @@ void SetProp_codeOn(oop exp, oop str, oop env) codeOn(str, Object_get(exp, sym_value ), 0); } -oop newGetArray(oop object, oop index) -{ - oop o = new(pGetArray); - Object_put(o, sym_object, object); - Object_put(o, sym_index , index ); - return o; -} - void oob(oop obj, int index) { fatal("[]: index %d out of bounds in %s", index, storeString(obj, 0)); @@ -1161,6 +1290,52 @@ oop *Object_aref(oop obj, int index) return _get(obj, Object,indexed) + index; } +oop newRefArray(oop object, oop index) +{ + oop o = new(pRefArray); + Object_put(o, sym_object, object); + Object_put(o, sym_index , index ); + return o; +} + +oop RefArray_eval(oop exp, oop env) +{ + oop obj = eval(Object_get(exp, sym_object), env); + oop ind = eval(Object_get(exp, sym_index ), env); + if (isInteger(ind)) { + int index = _integerValue(ind); + switch (getType(obj)) { + case String: goto error; + case Symbol: goto error; + case Object: return mkptr(Object_aref(obj, index)); + default: goto error; + } + } + if (is(Object, obj)) { + oop *ref = Object_refLocal(obj, ind); + if (ref) return mkptr(ref); + } + error: + fatal("[]: %s is not an object", storeString(obj, 0)); + return 0; +} + +void RefArray_codeOn(oop exp, oop str, oop env) +{ + codeOn(str, Object_get(exp, sym_object), 0); + String_appendAll(str, "["); + codeOn(str, Object_get(exp, sym_index), 0); + String_appendAll(str, "]"); +} + +oop newGetArray(oop object, oop index) +{ + oop o = new(pGetArray); + Object_put(o, sym_object, object); + Object_put(o, sym_index , index ); + return o; +} + oop GetArray_eval(oop exp, oop env) { oop obj = eval(Object_get(exp, sym_object), env); @@ -1171,7 +1346,7 @@ oop GetArray_eval(oop exp, oop env) case String: return newInteger(*String_aref(obj, index)); case Symbol: return newInteger(*Symbol_aref(obj, index)); case Object: return *Object_aref(obj, index); - default: fatal("[]: %s is not indexable", storeString(obj, 0)); + default: fatal("[]: %s is not indexable", storeString(obj, 0)); } } if (!is(Object, obj)) fatal("[]: %s is not an object", storeString(obj, 0)); @@ -1245,16 +1420,16 @@ oop newApply(oop function, oop arguments) int isFixed(oop func) { # if PRIMCLOSURE - return is(Closure, func) && _get(func, Closure,fixed); + return is(Closure, func) && nil != _get(func, Closure,fixed); # else - return Object_getLocal(func, sym_fixed) != nil; + return nil != Object_getLocal(func, sym_fixed); # endif } oop Call_eval(oop exp, oop env) { oop cfunc = eval (Object_get(exp, sym_function ), env); - oop cargs = Object_get(exp, sym_arguments); + oop cargs = Object_get(exp, sym_arguments); if (!isFixed(cfunc)) cargs = evargs(cargs, env); return apply(cfunc, nil, cargs, env); } @@ -1263,15 +1438,15 @@ void codeArgumentsOn(oop str, oop object, char *begin, char *end) { String_appendAll(str, begin); oop *indexed = _get(object, Object,indexed); - int isize = _get(object, Object,isize); - int i; - for (i = 0; i < isize; ++i) { + int isize = _get(object, Object,isize); + int i; + for (i = 0; i < isize; ++i) { if (i) String_appendAll(str, ", "); codeOn(str, indexed[i], 0); } struct property *kvs = _get(object, Object,properties); - int psize = _get(object, Object,psize); - for (int j = 0; j < psize; ++j) { + int psize = _get(object, Object,psize); + for (int j = 0; j < psize; ++j) { if (prop_delegate == kvs[j].key && pObject == kvs[j].val) continue; if (i++) String_appendAll(str, ", "); printOn(str, kvs[j].key, 0); @@ -1290,16 +1465,16 @@ void Call_codeOn(oop exp, oop str, oop env) oop newInvoke(oop self, oop method, oop arguments) { oop o = new(pInvoke); - Object_put(o, sym_self , self ); - Object_put(o, sym_method , method ); + Object_put(o, sym_self , self ); + Object_put(o, sym_method , method ); Object_put(o, sym_arguments, arguments); return o; } oop Invoke_eval(oop exp, oop env) { - oop self = eval (Object_get(exp, sym_self ), env); - oop meth = Object_get(exp, sym_method ) ; + oop self = eval (Object_get(exp, sym_self ), env); + oop meth = Object_get(exp, sym_method ) ; oop iargs = evargs(Object_get(exp, sym_arguments), env); oop ifunc = Object_get(self, meth); // fails if property not defined return apply(ifunc, self, iargs, env); @@ -1388,14 +1563,14 @@ oop newLambda(oop parameters, oop body) { oop o = new(pLambda); Object_put(o, sym_parameters, parameters); - Object_put(o, sym_body , body ); + Object_put(o, sym_body , body ); return o; } oop newClosure(oop function, oop environment) { oop o = new(pClosure); - Object_put(o, sym_function , function ); + Object_put(o, sym_function , function ); Object_put(o, sym_environment, environment); return o; } @@ -1423,22 +1598,27 @@ oop Closure_eval(oop exp, oop env) void Closure_codeOn(oop exp, oop str, oop env) { - assert(!"this cannot happen"); + printOn(str, exp, 0); } #endif // !PRIMCLOSURE #define doBinops(_) \ - _(opLogOr, ||) \ - _(opLogAnd, &&) \ - _(opBitOr, |) \ - _(opBitXor, ^) \ - _(opBitAnd, &) \ - _(opEq, ==) _(opNotEq, !=) \ - _(opLess, < ) _(opLessEq, <=) _(opGrtr, >=) _(opGrtrEq, > ) \ - _(opShl, <<) _(opShr, >>) \ - _(opAdd, +) _(opSub, -) \ - _(opMul, *) _(opDiv, /) _(opMod, %) + _(opLogOr, ||) \ + _(opLogAnd, &&) \ + _(opBitOr, |) \ + _(opBitXor, ^) \ + _(opBitAnd, &) \ + _(opEq, ==) _(opNotEq, !=) \ + _(opLess, < ) _(opLessEq, <=) _(opGrtr, >=) _(opGrtrEq, > ) \ + _(opShl, <<) _(opShr, >>) \ + _(opAdd, +) _(opSub, -) \ + _(opMul, *) _(opDiv, /) _(opMod, %) \ + _(opPostAdd, ++) _(opPostDec, --) \ + _(opPreOr, |=) _(opPreXor, ^=) _(opPreAnd, &=) \ + _(opPreShl, >>=) _(opPreShr, <<=) \ + _(opPreAdd, +=) _(opPreSub, -=) \ + _(opPreMul, *=) _(opPreDiv, /=) _(opPreMod, %=) #define defineBinop(NAME, OP) NAME, enum binop { @@ -1464,10 +1644,14 @@ oop newBinop(int operation, oop lhs, oop rhs) intptr_t cmp(oop l, oop r, char *who) { int tl = getType(l), tr = getType(r); - if (Integer == tl && Integer == tr) return _integerValue(l) - _integerValue(r); - if (Float == tl || Float == tr) return floatValue(l, who) - floatValue(r, who); - if (String == tl || String == tr) return strcmp(stringValue(l, who), stringValue(r, who)); - if (Symbol == tl || Symbol == tr) return strcmp(stringValue(l, who), stringValue(r, who)); + if (Integer == tl && Integer == tr) return _integerValue(l) - _integerValue(r); + if (Float == tl || Float == tr) return floatValue(l, who) - floatValue(r, who); + if (String == tl && String == tr) { + int ll = _get(l, String,length), rr = _get(r, String,length); + if (ll == rr) return strncmp(_get(l, String,value), _get(r, String,value), ll); + return ll - rr; + } + if (Symbol == tl && Symbol == tr) return strcmp(stringValue(l, who), stringValue(r, who)); return (intptr_t)l - (intptr_t)r; } @@ -1494,7 +1678,7 @@ oop NAME(oop l, oop r) \ { \ int tl = getType(l), tr = getType(r); \ if (Integer == tl && Integer == tr) return newInteger(_integerValue(l ) OP _integerValue(r )); \ - if (Float == tl || Float == tr) return newFloat ( floatValue(l, #OP) OP floatValue(r, #OP)); \ + if (Float == tl || Float == tr) return newFloat ( floatValue(l, #OP) OP floatValue(r, #OP)); \ fatal(#OP": illegal operand types %s and %s", getTypeName(l), getTypeName(r)); \ return 0; \ } @@ -1522,8 +1706,8 @@ oop quo(oop l, oop r) oop rem(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 (fmod(floatValue(l, "%"), floatValue(r, "%"))); + if (Integer == tl && Integer == tr) return newInteger( _integerValue(l) % _integerValue(r ) ); + if (Float == tl || Float == tr) return newFloat (fmod(floatValue(l, "%"), floatValue(r, "%"))); fatal("/: illegal operand types %s and %s", getTypeName(l), getTypeName(r)); return 0; } @@ -1544,38 +1728,114 @@ oop Binop_eval(oop exp, oop env) } rhs = eval(rhs, env); switch (code) { + case opLogOr: break; + case opLogAnd: break; case opBitOr: return newInteger(integerValue(lhs, "|") | integerValue(rhs, "|")); case opBitXor: return newInteger(integerValue(lhs, "^") ^ integerValue(rhs, "^")); case opBitAnd: return newInteger(integerValue(lhs, "&") & integerValue(rhs, "&")); case opEq: return newBoolean(cmp(lhs, rhs, "==") == 0); case opNotEq: return newBoolean(cmp(lhs, rhs, "!=") != 0); - case opLess: return newBoolean(cmp(lhs, rhs, "<" ) < 0); + case opLess: return newBoolean(cmp(lhs, rhs, "<" ) < 0); case opLessEq: return newBoolean(cmp(lhs, rhs, "<=") <= 0); case opGrtrEq: return newBoolean(cmp(lhs, rhs, ">=") >= 0); - case opGrtr: return newBoolean(cmp(lhs, rhs, ">" ) > 0); + case opGrtr: return newBoolean(cmp(lhs, rhs, ">" ) > 0); case opShl: return shl(lhs, rhs); case opShr: return shr(lhs, rhs); - case opAdd: return add(lhs, rhs); - case opSub: return sub(lhs, rhs); - case opMul: return mul(lhs, rhs); - case opDiv: return quo(lhs, rhs); - case opMod: return rem(lhs, rhs); - default: break; + case opAdd: return add(lhs, rhs); + case opSub: return sub(lhs, rhs); + case opMul: return mul(lhs, rhs); + case opDiv: return quo(lhs, rhs); + case opMod: return rem(lhs, rhs); + case opPostAdd: + case opPostDec: { assert(isInteger(lhs)); // ref + oop *ref = (oop *)(intptr_t)_integerValue(lhs); + oop value = *ref; assert(isInteger(rhs)); // delta + int amount = _integerValue(rhs); + if (code == opPostDec) amount = -amount; + switch (getType(value)) { + case Integer: *ref = newInteger(_integerValue(value) + amount); break; + case Float: *ref = newFloat (_floatValue (value) + amount); break; + default: fatal("++/--: non-numeric argument"); + } + return value; + } + case opPreOr ... opPreMod: { assert(isInteger(lhs)); // ref + oop *ref = (oop *)(intptr_t)_integerValue(lhs); + oop val = *ref; assert(isInteger(rhs)); // delta + switch (code) { + case opPreOr ... opPreShr: { + long l = integerValue(val, binopNames[code]); + long r = integerValue(rhs, binopNames[code]); + switch (code) { + case opPreOr: l |= r; break; + case opPreXor: l ^= r; break; + case opPreAnd: l &= r; break; + case opPreShl: l <<= r; break; + case opPreShr: l >>= r; break; + default: assert(!"this cannot happen"); + } + return *ref = newInteger(l); + } + case opPreAdd ... opPreMod: { + if (isInteger(val) && isInteger(rhs)) { + long l = _integerValue(val), r = _integerValue(rhs); + switch (code) { + case opPreAdd: l += r; break; + case opPreSub: l -= r; break; + case opPreMul: l *= r; break; + case opPreDiv: + if (!r) fatal("division by zero"); + l /= r; + break; + case opPreMod: + if (!r) fatal("division by zero"); + l %= r; + break; + default: assert(!"this cannot happen"); + } + return *ref = newInteger(l); + } + double l = floatValue(val, binopNames[code]); + double r = floatValue(rhs, binopNames[code]); + switch (code) { + case opPreAdd: l += r; break; + case opPreSub: l -= r; break; + case opPreMul: l *= r; break; + case opPreDiv: + if (!r) fatal("division by zero"); + l /= r; + break; + case opPreMod: + if (!r) fatal("division by zero"); + l = fmod(l, r); + break; + default: assert(!"this cannot happen"); + } + return *ref = newFloat(l); + } + default: assert(!"this cannot happen"); + } + } } fatal("illegal binary operation %d", code); return 0; } void Binop_codeOn(oop exp, oop str, oop env) -{ assert(_get(exp, Object,isize) == 2); - oop op = Object_get(exp, sym_operation); - oop lhs = _get(exp, Object,indexed)[0]; - oop rhs = _get(exp, Object,indexed)[1]; - codeOn(str, lhs, 0); - enum binop code = integerValue(op, "Binop.operation"); - assert(0 <= code && code <= indexableSize(binopNames)); - String_format(str, " %s ", binopNames[code]); - codeOn(str, rhs, 0); +{ + if (_getDelegate(exp) == pBinop) { assert(_get(exp, Object,isize) == 2); + oop op = Object_get(exp, sym_operation); + oop lhs = _get(exp, Object,indexed)[0]; + oop rhs = _get(exp, Object,indexed)[1]; + codeOn(str, lhs, 0); + enum binop code = integerValue(op, "Binop.operation"); + assert(0 <= code && code <= indexableSize(binopNames)); + String_format(str, " %s ", binopNames[code]); + codeOn(str, rhs, 0); + } + else { + printOn(str, exp, 0); + } } #define doUnyops(_) \ @@ -1609,19 +1869,19 @@ oop quasiclone(oop exp, oop env) { if (is(Object, exp)) { if (pUnyop == _getDelegate(exp)) { - oop op = Object_get(exp, sym_operation); - oop value = _get(exp, Object,indexed)[0]; + oop op = Object_get(exp, sym_operation); + oop value = _get(exp, Object,indexed)[0]; enum unyop code = integerValue(op, "Unyop.operation"); if (code == opUnquote) return eval(value, env); } oop clone = new(_getDelegate(exp)); oop *indexed = _get(exp, Object,indexed); int isize = _get(exp, Object,isize); - for (int i = 0; i < isize; ++i) + for (int i = 0; i < isize; ++i) Object_push(clone, quasiclone(indexed[i], env)); struct property *kvs = _get(exp, Object,properties); - int psize = _get(exp, Object,psize); - for (int i = 0; i < psize; ++i) + int psize = _get(exp, Object,psize); + for (int i = 0; i < psize; ++i) if (kvs[i].key != prop_delegate) Object_put(clone, kvs[i].key, quasiclone(kvs[i].val, env)); oop delegate = _getDelegate(exp); @@ -1637,7 +1897,7 @@ oop neg(oop n) int tn = getType(n); switch (tn) { case Integer: return newInteger(-_integerValue(n)); - case Float: return newFloat (-_floatValue (n)); + case Float: return newFloat (-_floatValue (n)); default: break; } fatal("-: illegal operand type %s", getTypeName(n)); @@ -1664,10 +1924,10 @@ oop Unyop_eval(oop exp, oop env) if (code == opUnquote ) fatal("@ outside quasiquotation"); value = eval(value, env); switch (code) { - case opNot: return newBoolean(value == nil); - case opNeg: return neg(value); - case opCom: return com(value); - default: break; + case opNot: return newBoolean(value == nil); + case opNeg: return neg(value); + case opCom: return com(value); + default: break; } fatal("illegal unary operation %d", code); return 0; @@ -1700,10 +1960,10 @@ oop Let_append(oop let, oop key, oop value) oop Let_eval(oop exp, oop env) { - oop keyvals = Object_getLocal(exp, sym_keyvals); + oop keyvals = Object_getLocal(exp, sym_keyvals); oop *indexed = get(keyvals, Object,indexed); - int isize = _get(keyvals, Object,isize); - oop result = nil; + 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; @@ -1711,9 +1971,9 @@ oop Let_eval(oop exp, oop env) void Let_codeOn(oop exp, oop str, oop env) { - oop keyvals = Object_getLocal(exp, sym_keyvals); + oop keyvals = Object_getLocal(exp, sym_keyvals); oop *indexed = get(keyvals, Object,indexed); - int isize = _get(keyvals, Object,isize); + int isize = _get(keyvals, Object,isize); String_appendAll(str, "let "); for (int i = 0; i < isize - 1; i += 2) { if (i) String_appendAll(str, ", "); @@ -1735,8 +1995,8 @@ oop newIf(oop condition, oop consequent, oop alternate) oop If_eval(oop exp, oop env) { oop condition = eval(Object_get(exp, sym_condition ), env); - oop consequent = Object_get(exp, sym_consequent) ; - oop alternate = Object_get(exp, sym_alternate ) ; + oop consequent = Object_get(exp, sym_consequent) ; + oop alternate = Object_get(exp, sym_alternate ) ; return eval(nil != condition ? consequent : alternate, env); } @@ -1759,15 +2019,15 @@ oop newWhile(oop condition, oop body) { oop o = new(pWhile); Object_put(o, sym_condition, condition ); - Object_put(o, sym_body, body ); + Object_put(o, sym_body, body ); return o; } oop While_eval(oop exp, oop env) { oop condition = Object_get(exp, sym_condition); - oop body = Object_get(exp, sym_body ); - oop result = nil; + oop body = Object_get(exp, sym_body ); + oop result = nil; while (nil != eval(condition, env)) result = eval(body, env); return result; } @@ -1775,7 +2035,7 @@ oop While_eval(oop exp, oop env) void While_codeOn(oop exp, oop str, oop env) { oop condition = Object_get(exp, sym_condition); - oop body = Object_get(exp, sym_body ); + oop body = Object_get(exp, sym_body ); String_appendAll(str, "while ("); codeOn(str, condition, 0); String_appendAll(str, ") "); @@ -1792,13 +2052,13 @@ oop newBlock(oop body) oop Block_eval(oop exp, oop env) { - oop body = Object_get(exp, sym_body); + oop body = Object_get(exp, sym_body); oop *indexed = _get(body, Object,indexed); - int size = _get(body, Object,isize); - oop result = nil; - oop env2 = new(pObject); + int size = _get(body, Object,isize); + oop result = nil; + oop env2 = new(pObject); _setDelegate(env2, env); - for (int i = 0; i < size; ++i) result = eval(indexed[i], env2); + for (int i = 0; i < size; ++i) result = eval(indexed[i], env2); return result; } @@ -1812,13 +2072,13 @@ oop newFor(oop initialise, oop condition, oop update, oop body) oop o = new(pFor); Object_put(o, sym_initialise, initialise); Object_put(o, sym_condition, condition); - Object_put(o, sym_update, update); - Object_put(o, sym_body, body); + Object_put(o, sym_update, update); + Object_put(o, sym_body, body); return o; } #define _PASTE(A, B) A##B -#define PASTE(A, B) _PASTE(A,B) +#define PASTE(A, B) _PASTE(A,B) #if NONLOCAL @@ -1830,7 +2090,7 @@ oop newFor(oop initialise, oop condition, oop update, oop body) case NLR_RETURN: nlrReturn(nlrPop(), NLR_RETURN); \ } -# define DONE() nlrPop() +# define DONE() nlrPop() #else # define LOOP() # define DONE() @@ -1840,12 +2100,12 @@ oop For_eval(oop exp, oop env) { oop initialise = Object_get(exp, sym_initialise); oop condition = Object_get(exp, sym_condition); - oop update = Object_get(exp, sym_update); - oop body = Object_get(exp, sym_body); + oop update = Object_get(exp, sym_update); + oop body = Object_get(exp, sym_body); oop env2 = new(pObject); _setDelegate(env2, env); - oop result = eval(initialise, env2); - int n = 0; + oop result = eval(initialise, env2); + int n = 0; LOOP(); if (n++) goto doContinue; for (;;) { @@ -1862,8 +2122,8 @@ void For_codeOn(oop exp, oop str, oop env) { oop initialise = Object_get(exp, sym_initialise); oop condition = Object_get(exp, sym_condition); - oop update = Object_get(exp, sym_update); - oop body = Object_get(exp, sym_body); + oop update = Object_get(exp, sym_update); + oop body = Object_get(exp, sym_body); String_appendAll(str, "for ("); codeOn(str, initialise, 0); String_appendAll(str, "; "); @@ -1879,7 +2139,7 @@ oop newForIn(oop identifier, oop expression, oop body) oop o = new(pForIn); Object_put(o, sym_identifier, identifier); Object_put(o, sym_expression, expression); - Object_put(o, sym_body, body); + Object_put(o, sym_body, body); return o; } @@ -1887,9 +2147,9 @@ oop ForIn_eval(oop exp, oop env) { oop identifier = Object_get(exp, sym_identifier); oop expression = Object_get(exp, sym_expression); - oop body = Object_get(exp, sym_body); - oop result = nil; - oop vals = eval(expression, env); + oop body = Object_get(exp, sym_body); + oop result = nil; + oop vals = eval(expression, env); oop env2 = new(pObject); _setDelegate(env2, env); if (isInteger(vals)) { @@ -1916,8 +2176,8 @@ oop ForIn_eval(oop exp, oop env) } if (!is(Object, vals)) fatal("for: non-object sequence %s", storeString(vals, 0)); oop *indexed = _get(vals, Object,indexed); - int size = _get(vals, Object,isize); - int i = -1; + int size = _get(vals, Object,isize); + int i = -1; LOOP(); while (++i < size) { Object_put(env2, identifier, indexed[i]); @@ -1931,7 +2191,7 @@ void ForIn_codeOn(oop exp, oop str, oop env) { oop identifier = Object_get(exp, sym_identifier); oop expression = Object_get(exp, sym_expression); - oop body = Object_get(exp, sym_body); + oop body = Object_get(exp, sym_body); String_appendAll(str, "for ("); printOn(str, identifier, 0); String_appendAll(str, " in "); @@ -1944,24 +2204,24 @@ oop newForFromTo(oop identifier, oop first, oop last, oop body) { oop o = new(pForFromTo); Object_put(o, sym_identifier, identifier); - Object_put(o, sym_first, first); - Object_put(o, sym_last, last); - Object_put(o, sym_body, body); + Object_put(o, sym_first, first); + Object_put(o, sym_last, last); + Object_put(o, sym_body, body); return o; } oop ForFromTo_eval(oop exp, oop env) { oop identifier = Object_get(exp, sym_identifier); - oop first = Object_get(exp, sym_first); - oop last = Object_get(exp, sym_last); - oop body = Object_get(exp, sym_body); - oop env2 = new(pObject); + oop first = Object_get(exp, sym_first); + oop last = Object_get(exp, sym_last); + oop body = Object_get(exp, sym_body); + oop env2 = new(pObject); _setDelegate(env2, env); - long start = integerValue(first, "for"); - long stop = integerValue(last, "for"); - long step = start < stop ? 1 : -1; - oop result = nil; + long start = integerValue(first, "for"); + long stop = integerValue(last, "for"); + long step = start < stop ? 1 : -1; + oop result = nil; start -= step; LOOP(); for (;;) { @@ -1977,9 +2237,9 @@ oop ForFromTo_eval(oop exp, oop env) void ForFromTo_codeOn(oop exp, oop str, oop env) { oop identifier = Object_get(exp, sym_identifier); - oop first = Object_get(exp, sym_first); - oop last = Object_get(exp, sym_last); - oop body = Object_get(exp, sym_body); + oop first = Object_get(exp, sym_first); + oop last = Object_get(exp, sym_last); + oop body = Object_get(exp, sym_body); String_appendAll(str, "for ("); printOn(str, identifier, 0); String_appendAll(str, " from "); @@ -2004,15 +2264,15 @@ oop newLiteral(oop object) oop Literal_eval(oop exp, oop env) { - oop object = Object_get(exp, sym_object); - oop clone = new(pObject); + oop object = Object_get(exp, sym_object); + oop clone = new(pObject); oop *indexed = _get(object, Object,indexed); - int isize = _get(object, Object,isize); - for (int i = 0; i < isize; ++i) + int isize = _get(object, Object,isize); + for (int i = 0; i < isize; ++i) Object_push(clone, eval(indexed[i], env)); struct property *kvs = _get(object, Object,properties); - int psize = _get(object, Object,psize); - for (int i = 0; i < psize; ++i) + int psize = _get(object, Object,psize); + for (int i = 0; i < psize; ++i) Object_put(clone, kvs[i].key, eval(kvs[i].val, env)); # if 0 oop delegate = _getDelegate(object); @@ -2026,15 +2286,15 @@ oop Literal_eval(oop exp, oop env) oop Literal_eval(oop exp, oop env) { - oop object = Object_get(exp, sym_object); - oop clone = new(pObject); + oop object = Object_get(exp, sym_object); + oop clone = new(pObject); oop *indexed = _get(object, Object,indexed); - int isize = _get(object, Object,isize); - for (int i = 0; i < isize; ++i) + int isize = _get(object, Object,isize); + for (int i = 0; i < isize; ++i) Object_push(clone, eval(indexed[i], env)); struct property *kvs = _get(object, Object,properties); - int psize = _get(object, Object,psize); - for (int i = 0; i < psize; ++i) + int psize = _get(object, Object,psize); + for (int i = 0; i < psize; ++i) Object_put(clone, kvs[i].key, eval(kvs[i].val, env)); return clone; } @@ -2043,24 +2303,27 @@ oop Literal_eval(oop exp, oop env) void Literal_codeOn(oop exp, oop str, oop env) { - oop object = Object_get(exp, sym_object); + oop object = Object_get(exp, sym_object); + codeOn(str, object, 0); +# if 0 oop *indexed = _get(object, Object,indexed); - int isize = _get(object, Object,isize); + int isize = _get(object, Object,isize); String_appendAll(str, "["); - int i; - for (i = 0; i < isize; ++i) { + int i; + for (i = 0; i < isize; ++i) { if (i) String_appendAll(str, ", "); codeOn(str, indexed[i], 0); } struct property *kvs = _get(object, Object,properties); - int psize = _get(object, Object,psize); - for (int j = 0; j < psize; ++j) { + int psize = _get(object, Object,psize); + for (int j = 0; j < psize; ++j) { if (i++) String_appendAll(str, ", "); codeOn(str, kvs[j].key, 0); String_appendAll(str, ": "); codeOn(str, kvs[j].val, 0); } String_appendAll(str, "]"); +# endif } %} @@ -2072,7 +2335,7 @@ start = - ( s:stmt { yysval = s } ) 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) } + ( COMMA k:id ASSIGN v:expr { Let_append(l, k, v) } )* SEMI { $$ = l } | WHILE LPAREN c:expr RPAREN s:stmt { $$ = newWhile(c, s) } | IF LPAREN c:expr RPAREN s:stmt @@ -2087,10 +2350,10 @@ stmt = LET l:mklet k:id ASSIGN v:expr { Let_append(l, k, v) } | FOR LPAREN i:id IN e:expr RPAREN s:stmt { $$ = newForIn(i, e, s) } | FOR LPAREN i:id FROM a:expr - TO b:expr RPAREN s:stmt { $$ = newForFromTo(i, a, b, s) } + 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)) } + 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)) } | b:block { $$ = newBlock(b) } | e:expr EOS { $$ = e } @@ -2098,24 +2361,35 @@ stmt = LET l:mklet k:id ASSIGN v:expr { Let_append(l, k, v) } mklet = { $$ = newLet() } proto = v:var ( DOT j:id !LPAREN { v = newGetProp(v, j) } - )* { $$ = v } + )* { $$ = v } EOS = SEMI+ | &RBRACE | &ELSE expr = p:postfix - ( DOT i:id ASSIGN e:expr { $$ = newSetProp(p, i, e) } - | LBRAK i:expr RBRAK ASSIGN e:expr { $$ = newSetArray(p, i, e) } + ( DOT i:id ASSIGN e:expr { $$ = newSetProp(p, i, e) } + | LBRAK i:expr RBRAK ASSIGN e:expr { $$ = newSetArray(p, i, e) } ) - | i:id ASSIGN e:expr { $$ = newSetVar(i, e) } + | i:id ASSIGN e:expr { $$ = newSetVar(i, e) } + | l:lvalue ( PLUSEQ r:expr { $$ = newBinop(opPreAdd, l, r) } + | MINUSEQ r:expr { $$ = newBinop(opPreSub, l, r) } + | STAREQ r:expr { $$ = newBinop(opPreMul, l, r) } + | SLASHEQ r:expr { $$ = newBinop(opPreDiv, l, r) } + | PCENTEQ r:expr { $$ = newBinop(opPreMod, l, r) } + | SHLEQ r:expr { $$ = newBinop(opPreShl, l, r) } + | SHREQ r:expr { $$ = newBinop(opPreShr, l, r) } + | ANDEQ r:expr { $$ = newBinop(opPreAnd, l, r) } + | XOREQ r:expr { $$ = newBinop(opPreXor, l, r) } + | OREQ r:expr { $$ = newBinop(opPreOr, l, r) } + ) | logor -logor = l:logand ( BARBAR r:logand { l = newBinop(opLogOr, l, r) } +logor = l:logand ( BARBAR r:logand { l = newBinop(opLogOr, l, r) } )* { $$ = l } logand = l:bitor ( ANDAND r:bitor { l = newBinop(opLogAnd, l, r) } )* { $$ = l } -bitor = l:bitxor ( OR r:bitxor { l = newBinop(opBitOr, l, r) } +bitor = l:bitxor ( OR r:bitxor { l = newBinop(opBitOr, l, r) } )* { $$ = l } bitxor = l:bitand ( XOR r:bitand { l = newBinop(opBitXor, l, r) } @@ -2124,77 +2398,95 @@ bitxor = l:bitand ( XOR r:bitand { l = newBinop(opBitXor, l, r) } bitand = l:eq ( AND r:eq { l = newBinop(opBitAnd, l, r) } )* { $$ = l } -eq = l:ineq ( EQ r:ineq { l = newBinop(opEq, l, r) } - | NOTEQ r:ineq { l = newBinop(opNotEq, l, r) } - )* { $$ = l } +eq = l:ineq ( EQ r:ineq { l = newBinop(opEq, l, r) } + | NOTEQ r:ineq { l = newBinop(opNotEq, l, r) } + )* { $$ = l } -ineq = l:shift ( LESS r:shift { l = newBinop(opLess, l, r) } - | LESSEQ r:shift { l = newBinop(opLessEq, l, r) } - | GRTREQ r:shift { l = newBinop(opGrtrEq, l, r) } - | GRTR r:shift { l = newBinop(opGrtr, l, r) } - )* { $$ = l } +ineq = l:shift ( LESS r:shift { l = newBinop(opLess, l, r) } + | LESSEQ r:shift { l = newBinop(opLessEq, l, r) } + | GRTREQ r:shift { l = newBinop(opGrtrEq, l, r) } + | GRTR r:shift { l = newBinop(opGrtr, l, r) } + )* { $$ = l } shift = l:sum ( SHL r:sum { l = newBinop(opShl, l, r) } - | SHR r:sum { l = newBinop(opShr, l, r) } - )* { $$ = l } + | SHR r:sum { l = newBinop(opShr, l, r) } + )* { $$ = l } -sum = l:prod ( PLUS r:prod { l = newBinop(opAdd, l, r) } - | MINUS r:prod { l = newBinop(opSub, l, r) } - )* { $$ = l } +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 } + | SLASH r:prefix { l = newBinop(opDiv, l, r) } + | PCENT r:prefix { l = newBinop(opMod, l, r) } + )* { $$ = l } -prefix = PLING p:prefix { $$ = newUnyop(opNot, p) } - | MINUS p:prefix { $$ = newUnyop(opNeg, p) } - | TILDE p:prefix { $$ = newUnyop(opCom, p) } +prefix = PPLUS l:lvalue { $$ = newBinop(opPreAdd, l, newInteger(1)) } + | MMINUS l:lvalue { $$ = newBinop(opPreSub, l, newInteger(1)) } + | PLING p:prefix { $$ = newUnyop(opNot, p) } + | MINUS p:prefix { $$ = newUnyop(opNeg, p) } + | TILDE p:prefix { $$ = newUnyop(opCom, p) } | BQUOTE s:stmt { $$ = newUnyop(opQuasiquote, s) } | COMMAT e:expr { $$ = newUnyop(opUnquote, e) } | postfix -postfix = p:primary - ( LBRAK e:expr RBRAK !ASSIGN { p = newGetArray(p, e) } - | DOT i:id a:args !ASSIGN !LBRACE { p = newInvoke(p, i, a) } - | DOT i:id !ASSIGN { p = newGetProp(p, i) } - | a:args !ASSIGN !LBRACE { p = newApply(p, a) } +lvalue = + l:primary + ( LBRAK e:expr RBRAK &(DOT | LBRAK | LPAREN) { l = newGetArray(l, e) } + | DOT i:id a:args &(DOT | LBRAK | LPAREN) { l = newInvoke(l, i, a) } + | DOT i:id &(DOT | LBRAK | LPAREN) { l = newGetProp(l, i) } + | a:args &(DOT | LBRAK | LPAREN) { l = newApply(l, a) } + )* + ( LBRAK e:expr RBRAK { l = newRefArray(l, e) } + | DOT i:id { l = newRefProp(l, i) } + ) { $$ = l } + | + i:id { $$ = newRefVar(i) } + +postfix = l:lvalue ( PPLUS { $$ = newBinop(opPostAdd, l, newInteger( 1)) } + | MMINUS { $$ = newBinop(opPostAdd, l, newInteger(-1)) } + ) + | p:primary + ( LBRAK e:expr RBRAK !ASSIGN { p = newGetArray(p, e) } + | DOT i:id a:args !ASSIGN !LBRACE { p = newInvoke(p, i, a) } + | DOT i:id !ASSIGN { p = newGetProp(p, i) } + | a:args !ASSIGN !LBRACE { p = newApply(p, a) } )* { $$ = p } args = LPAREN a:mkobj ( ( k:id COLON e:expr { Object_put(a, k, e) } | e: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:expr { Object_put(a, k, e) } + | e:expr { Object_push(a, e) } ) )* )? RPAREN { $$ = a } params = LPAREN p:mkobj ( i:id { Object_push(p, i) } - ( COMMA i:id { Object_push(p, i) } + ( COMMA i:id { Object_push(p, i) } )* )? RPAREN { $$ = p } -mkobj = { $$ = new(pObject) } +mkobj = { $$ = new(pObject) } -primary = nil | number | string | symbol | var | lambda | subexpr | literal +primary = nil | number | string | symbol | var | lambda | subexpr | literal lambda = p:params b:block { $$ = newLambda(p, b) } -subexpr = LPAREN e:expr RPAREN { $$ = e } - | b:block { $$ = newBlock(b) } +subexpr = LPAREN e:expr RPAREN { $$ = e } + | b:block { $$ = newBlock(b) } -literal = LBRAK o:mkobj +literal = LBRAK o:mkobj ( ( i:id COLON e:expr { Object_put(o, i, e) } | e:expr { Object_push(o, e) } ) ( COMMA ( i:id COLON e:expr { Object_put(o, i, e) } - | e:expr { Object_push(o, e) } - ) )* )? RBRAK { $$ = newLiteral(o) } + | e:expr { Object_push(o, e) } + ) )* )? RBRAK { $$ = newLiteral(o) } block = LBRACE b:mkobj - ( e:stmt { Object_push(b, e) } + ( e:stmt { Object_push(b, e) } )* RBRACE { $$ = b } -nil = NIL { $$ = nil } +nil = NIL { $$ = nil } number = "-" u:unsign { $$ = neg(u) } | "+" n:number { $$ = u } @@ -2230,53 +2522,65 @@ EXP = [eE] SIGN DIGIT+ SPACE = [ \t] | EOL | '//' (!EOL .)* EOL = [\n\r] { ++lineno } -NIL = "nil" !ALNUM - +NIL = "nil" !ALNUM - WHILE = "while" !ALNUM - -IF = "if" !ALNUM - +IF = "if" !ALNUM - ELSE = "else" !ALNUM - -FOR = "for" !ALNUM - -IN = "in" !ALNUM - +FOR = "for" !ALNUM - +IN = "in" !ALNUM - FROM = "from" !ALNUM - -TO = "to" !ALNUM - -LET = "let" !ALNUM - -CONT = "continue" !ALNUM - -BREAK = "break" !ALNUM - -RETURN = "return" !ALNUM - - -BQUOTE = "`" - -COMMAT = "@" - -HASH = "#" - -SEMI = ";" - -ASSIGN = "=" ![=] - -COMMA = "," - -COLON = ":" - -LPAREN = "(" - -RPAREN = ")" - -LBRAK = "[" - -RBRAK = "]" - -LBRACE = "{" - -RBRACE = "}" - -BARBAR = "||" ![=] - -ANDAND = "&&" ![=] - +TO = "to" !ALNUM - +LET = "let" !ALNUM - +CONT = "continue" !ALNUM - +BREAK = "break" !ALNUM - +RETURN = "return" !ALNUM - + +BQUOTE = "`" - +COMMAT = "@" - +HASH = "#" - +SEMI = ";" - +ASSIGN = "=" ![=] - +COMMA = "," - +COLON = ":" - +LPAREN = "(" - +RPAREN = ")" - +LBRAK = "[" - +RBRAK = "]" - +LBRACE = "{" - +RBRACE = "}" - +BARBAR = "||" ![=] - +ANDAND = "&&" ![=] - OR = "|" ![|=] - +OREQ = "|=" - XOR = "^" ![=] - +XOREQ = "^=" - AND = "&" ![&=] - -EQ = "==" - -NOTEQ = "!=" - -LESS = "<" ![<=] - -LESSEQ = "<=" - -GRTREQ = ">=" - -GRTR = ">" ![=] - -SHL = "<<" ![=] - -SHR = ">>" ![=] - -PLUS = "+" ![+=] - -MINUS = "-" ![-=] - -STAR = "*" ![=] - -SLASH = "/" ![/=] - -PCENT = "%" ![*=] - -DOT = "." - +ANDEQ = "&=" - +EQ = "==" - +NOTEQ = "!=" - +LESS = "<" ![<=] - +LESSEQ = "<=" - +GRTREQ = ">=" - +GRTR = ">" ![=] - +SHL = "<<" ![=] - +SHLEQ = "<<=" - +SHR = ">>" ![=] - +SHREQ = ">>=" - +PLUS = "+" ![+=] - +PLUSEQ = "+=" - +PPLUS = "++" - +MINUS = "-" ![-=] - +MINUSEQ = "-=" - +MMINUS = "--" - +STAR = "*" ![=] - +STAREQ = "*=" - +SLASH = "/" ![/=] - +SLASHEQ = "/=" - +PCENT = "%" ![=] - +PCENTEQ = "%=" - +DOT = "." - PLING = "!" ![=] - -TILDE = "~" - +TILDE = "~" - %%; @@ -2304,29 +2608,29 @@ 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,function); - oop environment = _get(func, Closure,environment); - oop parameters = _get(lambda, Lambda,parameters); - oop body = _get(lambda, Lambda,body); + 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)) + if (Object != functype || pClosure != _getDelegate(func)) fatal("cannot %s %s", (nil == self ? "call" : "invoke"), storeString(func, 0)); - 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); + 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); #endif - oop *exprs = get(body, Object,indexed); - int size = _get(body, Object,isize); - oop result = nil; + oop *exprs = get(body, Object,indexed); + int size = _get(body, Object,isize); + oop result = nil; assert(is(Object, args)); // inherit from closure's captured environment _setDelegate(args, environment); Object_put(args, sym_self, self); - int nparam = _get(parameters, Object,isize); + int nparam = _get(parameters, Object,isize); oop *pparam = _get(parameters, Object,indexed); - int nargs = _get(args, Object,isize); - oop *pargs = _get(args, Object,indexed); + int nargs = _get(args, Object,isize); + oop *pargs = _get(args, Object,indexed); # if NONLOCAL switch (nlrPush()) { case NLR_CONTINUE: fatal("continue outside loop"); @@ -2336,7 +2640,7 @@ oop apply(oop func, oop self, oop args, oop env) # endif for (int i = 0; i < nparam; ++i) Object_put(args, pparam[i], i < nargs ? pargs[i] : nil); - for (int i = 0; i < size; ++i) + for (int i = 0; i < size; ++i) result = eval(exprs[i], args); # if NONLOCAL nlrPop(); @@ -2362,7 +2666,7 @@ oop getArgType(oop args, int index, int type, char *who) enum typecode getTypecode(oop exp) { oop delegate = _getDelegate(exp); - oop name = Object_getLocal(delegate, prop_name); + oop name = Object_getLocal(delegate, prop_name); return is(Symbol, name) ? _get(name, Symbol,typecode) : UNDEFINED_TYPECODE; } @@ -2370,7 +2674,7 @@ enum typecode getTypecode(oop exp) #define defineEval(NAME) \ static inline oop prim_##NAME##_eval(oop func, oop exp, oop args, oop env) { \ - return NAME##_eval(exp, env); \ + return NAME##_eval(exp, env); \ } doProtos(defineEval) @@ -2381,7 +2685,7 @@ doProtos(defineEval) #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); \ + NAME##_codeOn(exp, getArgType(args, 0, String, #NAME".codeOn"), env); \ return exp; \ } \ @@ -2395,9 +2699,9 @@ static inline oop evalobj(oop exp, oop env) switch (getTypecode(exp)) { case UNDEFINED_TYPECODE: break; -# define defineEval(NAME) case t##NAME: return NAME##_eval(exp, env); +# define defineEval(NAME) case t##NAME: return NAME##_eval(exp, env); doProtos(defineEval); -# undef defineEval +# undef defineEval } # endif // TYPECODES @@ -2424,16 +2728,16 @@ oop eval(oop exp, oop env) oop evargs(oop list, oop env) { if (!is(Object, list)) return list; - int isize = _get(list, Object,isize); - int psize = _get(list, Object,psize); - oop *indexed = _get(list, Object,indexed); + int isize = _get(list, Object,isize); + int psize = _get(list, Object,psize); + oop *indexed = _get(list, Object,indexed); struct property *props = _get(list, Object,properties); - oop *indexed2 = isize ? xmalloc(sizeof(*indexed2) * isize) : 0; - struct property *props2 = psize ? xmalloc(sizeof(*props2 ) * psize) : 0; - for (int i = 0; i < isize; ++i) + oop *indexed2 = isize ? xmalloc(sizeof(*indexed2) * isize) : 0; + struct property *props2 = psize ? xmalloc(sizeof(*props2 ) * psize) : 0; + for (int i = 0; i < isize; ++i) indexed2[i] = eval(indexed[i], env); - for (int i = 0; i < psize; ++i) { - props2[i].key = props[i].key ; + for (int i = 0; i < psize; ++i) { + props2[i].key = props[i].key ; props2[i].val = eval(props[i].val, env); } return newObjectWith(isize, indexed2, psize, props2); @@ -2448,9 +2752,9 @@ oop prim_new(oop func, oop self, oop args, oop env) oop prim_push(oop func, oop self, oop args, oop env) { assert(is(Object, args)); if (!is(Object, self)) fatal("push: not an object"); - int argc = _get(args, Object,isize); + int argc = _get(args, Object,isize); oop *indexed = _get(args, Object,indexed); - for (int i = 0; i < argc; ++i) Object_push(self, indexed[i]); + for (int i = 0; i < argc; ++i) Object_push(self, indexed[i]); return self; } @@ -2480,9 +2784,9 @@ oop prim_keys(oop func, oop self, oop args, oop env) case Undefined: case Integer: case Float: case String: case Symbol: case Primitive: break; case Object: { - int size = _get(self, Object,psize); + 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); + for (int i = 0; i < size; ++i) Object_push(keys, kvs[i].key); break; } # if PRIMCLOSURE @@ -2509,10 +2813,10 @@ oop prim_env(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); + 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); + oop result = nil; + for (int i = 0; i < argc; ++i) result = eval(indexed[i], env); return result; } @@ -2523,24 +2827,24 @@ oop prim___eval__(oop func, oop self, oop args, oop env) oop prim_print(oop func, oop self, oop args, oop env) { - int argc = _get(args, Object,isize); + int argc = _get(args, Object,isize); oop *indexed = _get(args, Object,indexed); - oop result = nil; - int indent = 0; + oop result = nil; + int indent = 0; if (nil != Object_getLocal(args, sym_full)) indent = 1; - for (int i = 0; i < argc; ++i) print(result = indexed[i], indent); + for (int i = 0; i < argc; ++i) print(result = indexed[i], indent); fflush(stdout); return nil; } oop prim_codeString(oop func, oop self, oop args, oop env) { - int argc = _get(args, Object,isize); + int argc = _get(args, Object,isize); oop *indexed = _get(args, Object,indexed); - oop result = newStringLen(0, 0); - int indent = 0; + oop result = newStringLen(0, 0); + int indent = 0; if (nil != Object_getLocal(args, sym_full)) indent = 1; - for (int i = 0; i < argc; ++i) codeOn(result, indexed[i], 0); + for (int i = 0; i < argc; ++i) codeOn(result, indexed[i], 0); return result; } @@ -2605,7 +2909,7 @@ oop prim_chr(oop func, oop self, oop args, oop env) { int argc = _get(args, Object,isize); oop str = newStringLen(0, 0); - for (int i = 0; i < argc; ++i) + for (int i = 0; i < argc; ++i) String_append(str, integerValue(_get(args, Object,indexed)[i], "chr")); return str; } @@ -2629,7 +2933,7 @@ oop prim_readfile(oop func, oop self, oop args, oop env) { oop str = newStringLen(0, 0); int argc = _get(args, Object,isize); - for (int i = 0; i < argc; ++i) { + for (int i = 0; i < argc; ++i) { oop name = _get(args, Object,indexed)[i]; if (!is(String, name)) fatal("readfile: non-string argument: %s", storeString(name, 0)); FILE *file = fopen(_get(name, String,value), "r"); @@ -2647,7 +2951,7 @@ oop prim_exit(oop func, oop self, oop args, oop env) { int argc = _get(args, Object,isize); int status = 0; - if (argc > 1) fatal("exit: too many arguments"); + if (argc > 1) fatal("exit: too many arguments"); if (argc == 1) status = integerValue(_get(args, Object,indexed)[0], "exit"); exit(status); return nil; @@ -2675,7 +2979,7 @@ oop replFile(FILE *in) result = eval(yysval, nil); if (opt_v) { printf("==> "); - if (opt_v >= 3) storeln(result, 1); + if (opt_v >= 3) storeln(result, 1); else if (opt_v >= 1) storeln(result, 0); } } @@ -2702,11 +3006,11 @@ int main(int argc, char **argv) { GC_INIT(); -# define defineProp(NAME) prop_##NAME = intern("__"#NAME"__"); +# define defineProp(NAME) prop_##NAME = intern("__"#NAME"__"); doProperties(defineProp); # undef defineProp -# define defineSym(NAME) sym_##NAME = intern(#NAME); +# define defineSym(NAME) sym_##NAME = intern(#NAME); doSymbols(defineSym); # undef defineSym @@ -2744,30 +3048,30 @@ int main(int argc, char **argv) doProtos(defineCodeOn); -# undef defineCodeOn +# undef defineCodeOn macros = Object_put(pSymbol, intern("macros"), new(pObject)); _set(intern("__env__" ), Symbol,value, newPrimitive(prim_env)); - _set(intern("eval" ), Symbol,value, newPrimitive(prim_eval)); - _set(intern("print" ), Symbol,value, newPrimitive(prim_print)); + _set(intern("eval" ), Symbol,value, newPrimitive(prim_eval)); + _set(intern("print" ), Symbol,value, newPrimitive(prim_print)); _set(intern("codeString" ), Symbol,value, newPrimitive(prim_codeString)); - _set(intern("sqrt" ), Symbol,value, newPrimitive(prim_sqrt)); - _set(intern("round" ), Symbol,value, newPrimitive(prim_round)); + _set(intern("sqrt" ), Symbol,value, newPrimitive(prim_sqrt)); + _set(intern("round" ), Symbol,value, newPrimitive(prim_round)); _set(intern("truncate" ), Symbol,value, newPrimitive(prim_truncate)); _set(intern("cputime" ), Symbol,value, newPrimitive(prim_cputime)); _set(intern("evaluations"), Symbol,value, newPrimitive(prim_evaluations)); - _set(intern("len" ), Symbol,value, newPrimitive(prim_len)); - _set(intern("ord" ), Symbol,value, newPrimitive(prim_ord)); - _set(intern("chr" ), Symbol,value, newPrimitive(prim_chr)); + _set(intern("len" ), Symbol,value, newPrimitive(prim_len)); + _set(intern("ord" ), Symbol,value, newPrimitive(prim_ord)); + _set(intern("chr" ), Symbol,value, newPrimitive(prim_chr)); _set(intern("readfile" ), Symbol,value, newPrimitive(prim_readfile)); - _set(intern("exit" ), Symbol,value, newPrimitive(prim_exit)); + _set(intern("exit" ), Symbol,value, newPrimitive(prim_exit)); - Object_put(pObject, intern("new"), newPrimitive(prim_new )); - Object_put(pObject, intern("push"), newPrimitive(prim_push )); - Object_put(pObject, intern("pop"), newPrimitive(prim_pop )); + Object_put(pObject, intern("new"), newPrimitive(prim_new )); + Object_put(pObject, intern("push"), newPrimitive(prim_push )); + Object_put(pObject, intern("pop"), newPrimitive(prim_pop )); Object_put(pObject, intern("length"), newPrimitive(prim_length)); - Object_put(pObject, intern("keys"), newPrimitive(prim_keys )); + Object_put(pObject, intern("keys"), newPrimitive(prim_keys )); trace = new(pObject); @@ -2775,7 +3079,7 @@ int main(int argc, char **argv) int repled = 0; - for (int argn = 1; argn < argc; ++argn) { + for (int argn = 1; argn < argc; ++argn) { char *arg = argv[argn]; if ('-' == *arg) { while (*++arg) {