diff --git a/minproto.leg b/minproto.leg index 6fe24b6..0c2be62 100644 --- a/minproto.leg +++ b/minproto.leg @@ -1,31 +1,31 @@ # minproto.leg -- minimal prototype langauge for semantic experiments # -# last edited: 2024-05-14 05:10:06 by piumarta on m1mbp +# last edited: 2024-05-14 05:13:24 by piumarta on m1mbp %{ ; #ifndef GC -# define GC 1 // do not fill memory with unreachable junk +# define GC 1 // do not fill memory with unreachable junk #endif #ifndef TAGS -# define TAGS 1 // Integer and Float are immediate values encoded in their object "pointer" +# define TAGS 1 // Integer and Float are immediate values encoded in their object "pointer" #endif -#ifndef TYPECODES // .eval() dispatches using switch(), instead of invoking a method -# define TYPECODES 0 // (approx. 210% performance increase, because no dynamic dispatch in eval()) +#ifndef TYPECODES // .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 // Lambda and Closure are primitive types, not subtypes of Object -# define PRIMCLOSURE 0 // (approx. 6% performance decrease, because every Object_get() is slower) +#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 // delegate is a member of Object structure, not a normal property -# define DELOPT 0 // (approx. 60% performance increase, because no associative lookup of __delegate__) +#ifndef DELOPT // delegate is a member of Object structure, not a normal property +# define DELOPT 0 // (approx. 60% performance increase, because no associative lookup of __delegate__) #endif -#ifndef NONLOCAL // support non-local control flow (return, break, continue) -# define NONLOCAL 1 // (approx. 5% [loop] to 55% [call] performance decrease, because of jmp_buf initialisations) +#ifndef NONLOCAL // support non-local control flow (return, break, continue) +# define NONLOCAL 1 // (approx. 5% [loop] to 55% [call] performance decrease, because of jmp_buf initialisations) #endif #include @@ -41,17 +41,17 @@ #if GC # include -# define xmalloc(N) (GC_malloc(N)) -# define xmallocAtomic(N) (GC_malloc_atomic(N)) -# define xrealloc(P, N) (GC_realloc(P, N)) +# define xmalloc(N) (GC_malloc(N)) +# define xmallocAtomic(N) (GC_malloc_atomic(N)) +# define xrealloc(P, N) (GC_realloc(P, N)) #else # define GC_INIT() -# define xmalloc(N) (calloc(1, N)) -# define xmallocAtomic(N) (calloc(1, N)) -# define xrealloc(P, N) (realloc(P, N)) +# define xmalloc(N) (calloc(1, N)) +# define xmallocAtomic(N) (calloc(1, N)) +# define xrealloc(P, N) (realloc(P, N)) #endif -#define indexableSize(A) (sizeof(A) / sizeof(*(A))) +#define indexableSize(A) (sizeof(A) / sizeof(*(A))) void fatal(char *fmt, ...); @@ -63,12 +63,12 @@ union object; typedef union object *oop; #if PRIMCLOSURE -#define doTypes(_) \ - _(Undefined) _(Integer) _(Float) _(String) _(Symbol) _(Primitive) \ - _(Lambda) _(Closure) +#define doTypes(_) \ + _(Undefined) _(Integer) _(Float) _(String) _(Symbol) _(Primitive) \ + _(Lambda) _(Closure) #else -#define doTypes(_) \ - _(Undefined) _(Integer) _(Float) _(String) _(Symbol) _(Primitive) +#define doTypes(_) \ + _(Undefined) _(Integer) _(Float) _(String) _(Symbol) _(Primitive) #endif #define makeType(X) X, @@ -86,10 +86,10 @@ 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 TAGBITS 2 +# define TAGMASK 3 +# define TAGINT Integer // 1 +# define TAGFLT Float // 2 #endif #if PRIMCLOSURE @@ -98,34 +98,34 @@ oop printOn(oop buf, oop obj, int indent); #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 #define doProperties(_) _(name) _(eval) _(delegate) _(codeon) -#define declareProp(NAME) oop prop_##NAME = 0; +#define declareProp(NAME) oop prop_##NAME = 0; 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 declareSym(NAME) oop sym_##NAME = 0; +#define declareSym(NAME) oop sym_##NAME = 0; doSymbols(declareSym); #undef declareSym @@ -136,61 +136,61 @@ doSymbols(declareSym); enum { NLR_RESULT = 0, // initialisation, no non-local flow NLR_CONTINUE, // non-local jump back to the start of active loop - NLR_BREAK, // non-local jump out of the active loop - NLR_RETURN, // non-local return from the active function -}; // passed to longjmp, returned from setjmp + NLR_BREAK, // non-local jump out of the active loop + NLR_RETURN, // non-local return from the active function +}; // 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; -#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(jmp_buf) * ++maxnlrs); \ + ++nnlrs; \ + nlrs[nnlrs - 1].ntrace = _get(trace, Object,isize); \ + setjmp(nlrs[nnlrs - 1].env); \ + }) -#define nlrReturn(VAL, TYPE) { \ - valnlr = VAL; \ - longjmp(nlrs[nnlrs-1].env, TYPE); \ +#define nlrReturn(VAL, TYPE) { \ + valnlr = VAL; \ + longjmp(nlrs[nnlrs-1].env, TYPE); \ } #define nlrPop() (_set(trace, Object,isize, nlrs[--nnlrs].ntrace), valnlr) #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; oop fixed, 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 +219,7 @@ enum type getType(oop obj) char *getTypeName(oop obj) { - int type = getType(obj); assert(0 <= type && type <= indexableSize(typeNames)); + int type = getType(obj); assert(0 <= type && type <= indexableSize(typeNames)); return typeNames[type]; } @@ -231,18 +231,18 @@ oop _checkType(oop obj, enum type type, char *file, int line) return obj; } -#define get(OBJ, TYPE,FIELD) (_checkType(OBJ, TYPE, __FILE__, __LINE__)->TYPE.FIELD) -#define set(OBJ, TYPE,FIELD, VAL) (_checkType(OBJ, TYPE, __FILE__, __LINE__)->TYPE.FIELD = VAL) +#define get(OBJ, TYPE,FIELD) (_checkType(OBJ, TYPE, __FILE__, __LINE__)->TYPE.FIELD) +#define set(OBJ, TYPE,FIELD, VAL) (_checkType(OBJ, TYPE, __FILE__, __LINE__)->TYPE.FIELD = VAL) #ifdef NDEBUG -# define _get(OBJ, TYPE,FIELD) ((OBJ)->TYPE.FIELD) -# define _set(OBJ, TYPE,FIELD, VAL) ((OBJ)->TYPE.FIELD = VAL) +# define _get(OBJ, TYPE,FIELD) ((OBJ)->TYPE.FIELD) +# define _set(OBJ, TYPE,FIELD, VAL) ((OBJ)->TYPE.FIELD = VAL) #else -# define _get(OBJ, TYPE,FIELD) get(OBJ, TYPE,FIELD) -# define _set(OBJ, TYPE,FIELD, VAL ) set(OBJ, TYPE,FIELD, VAL) +# define _get(OBJ, TYPE,FIELD) get(OBJ, TYPE,FIELD) +# define _set(OBJ, TYPE,FIELD, VAL ) set(OBJ, TYPE,FIELD, VAL) #endif -#define make(TYPE) make_(sizeof(struct TYPE), TYPE) +#define make(TYPE) make_(sizeof(struct TYPE), TYPE) oop make_(size_t size, enum type type) { @@ -262,7 +262,7 @@ oop newInteger(long value) # endif } -#define isInteger(obj) is(Integer, obj) +#define isInteger(obj) is(Integer, obj) long _integerValue(oop obj) { @@ -304,16 +304,16 @@ double _floatValue(oop obj) double floatValue(oop obj, char *op) { switch (getType(obj)) { - case Integer: return (double)_integerValue(obj); - case Float: return (double)_floatValue(obj); - default: fatal("%s: non-numeric operand", op); + case Integer: return (double)_integerValue(obj); + case Float: return (double)_floatValue(obj); + default: fatal("%s: non-numeric operand", op); } return 0; } 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; @@ -329,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; @@ -338,17 +338,17 @@ 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; + ++string; + value = value * base + d; } *stringp = string; 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) { @@ -358,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); @@ -369,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); @@ -386,16 +386,16 @@ 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); - va_list ap; - va_start(ap, fmt); - len = vsnprintf(value + length, cap, fmt, ap); - va_end(ap); - if (len < cap) break; - cap += len; + value = xrealloc(value, length + cap); + va_list ap; + va_start(ap, fmt); + len = vsnprintf(value + length, cap, fmt, ap); + va_end(ap); + if (len < cap) break; + cap += len; } set(str, String,value, value); set(str, String,length, length+len); @@ -413,27 +413,27 @@ oop newStringEscaped(char *string) { oop buf = newStringLen(0, 0); while (*string) { - int c = *string++; - if ('\\' == c && *string) { - c = *string++; assert(c != 0); - switch (c) { - case '\"': c = '\"'; break; - case '\'': c = '\''; break; - case '\\': c = '\\'; break; - case 'a' : c = '\a'; break; - case 'b' : c = '\b'; break; - case 'f' : c = '\f'; break; - case 'n' : c = '\n'; break; - case 'r' : c = '\r'; break; - case 't' : c = '\t'; break; - case 'v' : c = '\v'; break; - 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; - } - } - String_append(buf, c); + int c = *string++; + if ('\\' == c && *string) { + c = *string++; assert(c != 0); + switch (c) { + case '\"': c = '\"'; break; + case '\'': c = '\''; break; + case '\\': c = '\\'; break; + case 'a' : c = '\a'; break; + case 'b' : c = '\b'; break; + case 'f' : c = '\f'; break; + case 'n' : c = '\n'; break; + case 'r' : c = '\r'; break; + case 't' : c = '\t'; break; + case 'v' : c = '\v'; break; + 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; + } + } + String_append(buf, c); } return buf; } @@ -470,7 +470,7 @@ int stringLength(oop obj, char *who) 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; } @@ -481,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; } @@ -497,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; @@ -505,12 +505,12 @@ oop intern(char *name) { ssize_t lo = 0, hi = nsymbols - 1; while (lo <= hi) { - ssize_t mid = (lo + hi) / 2; - oop sym = symbols[mid]; - int cmp = strcmp(name, _get(sym, Symbol,name)); - if (cmp < 0) hi = mid - 1; - else if (cmp > 0) lo = mid + 1; - else return sym; + ssize_t mid = (lo + hi) / 2; + oop sym = symbols[mid]; + int cmp = strcmp(name, _get(sym, Symbol,name)); + if (cmp < 0) hi = mid - 1; + else if (cmp > 0) lo = mid + 1; + else return sym; } symbols = xrealloc(symbols, sizeof(*symbols) * ++nsymbols); memmove(symbols + lo + 1, symbols + lo, sizeof(*symbols) * (nsymbols - 1 - lo)); @@ -537,10 +537,10 @@ oop Object_push(oop obj, oop val) size_t cap = _get(obj, Object,icap ); oop *indexed = _get(obj, Object,indexed); if (size >= cap) { - cap = cap ? cap * 2 : 4; - indexed = xrealloc(indexed, sizeof(*indexed) * cap); - _set(obj, Object,icap, cap); - _set(obj, Object,indexed, indexed); + cap = cap ? cap * 2 : 4; + indexed = xrealloc(indexed, sizeof(*indexed) * cap); + _set(obj, Object,icap, cap); + _set(obj, Object,indexed, indexed); } indexed[size++] = val; _set(obj, Object,isize, size); @@ -552,23 +552,23 @@ 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; } ssize_t Object_find(oop obj, oop key) { - ssize_t hi = get(obj, Object,psize) - 1; // asserts obj is Object + ssize_t hi = get(obj, Object,psize) - 1; // asserts obj is Object if (hi < 0) return -1; struct property *kvs = _get(obj, Object,properties); ssize_t lo = 0; while (lo <= hi) { - ssize_t mid = (lo + hi) / 2; - oop midkey = kvs[mid].key; - if (key < midkey) hi = mid - 1; - else if (key > midkey) lo = mid + 1; - else return mid; + ssize_t mid = (lo + hi) / 2; + oop midkey = kvs[mid].key; + if (key < midkey) hi = mid - 1; + else if (key > midkey) lo = mid + 1; + else return mid; } return -1 - lo; } @@ -590,10 +590,10 @@ oop Object_getLocal(oop obj, oop key) } #if DELOPT -# define _getDelegate(OBJ) _get(OBJ, Object,delegate) +# define _getDelegate(OBJ) _get(OBJ, Object,delegate) # define _setDelegate(OBJ, VAL) _set(OBJ, Object,delegate, VAL) #else -# define _getDelegate(OBJ) Object_getLocal(OBJ, prop_delegate) +# define _getDelegate(OBJ) Object_getLocal(OBJ, prop_delegate) # define _setDelegate(OBJ, VAL) Object_put(OBJ, prop_delegate, VAL) #endif @@ -603,38 +603,38 @@ 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; + 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; + 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; - } + 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); + 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; @@ -644,38 +644,38 @@ 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 ); - 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; + 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; - } + 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) 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); + 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 nil; @@ -684,9 +684,9 @@ oop Object_get(oop obj, oop key) oop *refvar(oop obj, oop key) { while (is(Object, obj)) { - ssize_t ind = Object_find(obj, key); - if (ind >= 0) return &_get(obj, Object,properties)[ind].val; - obj = _getDelegate(obj); + 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)); @@ -696,9 +696,9 @@ oop *refvar(oop obj, oop key) oop getvar(oop obj, oop key) { while (is(Object, obj)) { - ssize_t ind = Object_find(obj, key); - if (ind >= 0) return _get(obj, Object,properties)[ind].val; - obj = _getDelegate(obj); + ssize_t ind = Object_find(obj, key); + if (ind >= 0) return _get(obj, Object,properties)[ind].val; + obj = _getDelegate(obj); } oop value = _get(key, Symbol,value); // asserts is(Symbol,key) if (UNDEFINED == value) fatal("undefined variable: %s", storeString(key, 0)); @@ -708,9 +708,9 @@ oop getvar(oop obj, oop key) oop setvar(oop obj, oop key, oop val) { while (is(Object, obj)) { - ssize_t ind = Object_find(obj, key); - if (ind >= 0) return _get(obj, Object,properties)[ind].val = val; - obj = _getDelegate(obj); + ssize_t ind = Object_find(obj, key); + if (ind >= 0) return _get(obj, Object,properties)[ind].val = val; + obj = _getDelegate(obj); } return is(Symbol, key) ? _set(key, Symbol,value, val) : nil; } @@ -719,49 +719,49 @@ 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, 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; + 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, 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) { # if DELOPT - if (key == prop_delegate) return _setDelegate(obj, val); + if (key == prop_delegate) return _setDelegate(obj, val); # endif - int size = _get(obj, Object,psize); - ind = -1 - ind; assert(0 <= ind && ind <= size); - kvs = xrealloc(kvs, sizeof(*kvs) * ++size); - _set(obj, Object,properties, kvs); - _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); + int size = _get(obj, Object,psize); + ind = -1 - ind; assert(0 <= ind && ind <= size); + kvs = xrealloc(kvs, sizeof(*kvs) * ++size); + _set(obj, Object,properties, kvs); + _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); 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 }; + [0] = (struct property) { prop_delegate, delegate }; # endif return obj; } @@ -769,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); @@ -786,11 +786,11 @@ 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) { - if (i) String_appendAll(str, ", "); - printOn(str, indexed[i], 0); + int isize = _get(object, Object,isize); + int i; + for (i = 0; i < isize; ++i) { + if (i) String_appendAll(str, ", "); + printOn(str, indexed[i], 0); } String_appendAll(str, end); } @@ -799,11 +799,11 @@ 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) { - if (i) String_appendAll(str, "; "); else String_appendAll(str, " "); - codeOn(str, indexed[i], 0); + 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); } if (isize) String_appendAll(str, " "); String_appendAll(str, "}"); @@ -812,38 +812,38 @@ 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 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 Symbol: String_format(str, "#%s", _get(obj, Symbol,name)); break; - case Primitive: { - String_appendAll(str, "'); - 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 Symbol: String_format(str, "#%s", _get(obj, Symbol,name)); break; + case Primitive: { + String_appendAll(str, "'); + break; + } #if PRIMCLOSURE - case Lambda: { - codeParametersOn(str, _get(obj, Lambda,parameters), "(", ")"); - codeBlockOn(str, _get(obj, Lambda,body)); - break; - } - case Closure: { - String_appendAll(str, ""); - break; - } + case Lambda: { + codeParametersOn(str, _get(obj, Lambda,parameters), "(", ")"); + codeBlockOn(str, _get(obj, Lambda,body)); + break; + } + case Closure: { + String_appendAll(str, ""); + break; + } #endif - case Object: { - oop evaluator = Object_get(obj, prop_codeon); - oop args = new(pObject); - Object_push(args, str); - apply(evaluator, obj, args, nil); - break; - } - default: - assert(!"this cannot happen"); + case Object: { + oop evaluator = Object_get(obj, prop_codeon); + oop args = new(pObject); + Object_push(args, str); + apply(evaluator, obj, args, nil); + break; + } + default: + assert(!"this cannot happen"); } return str; } @@ -851,99 +851,99 @@ 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 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; - case Symbol: String_appendAll(buf, _get(obj, Symbol,name)); break; - case Primitive: { - String_appendAll(buf, "'); - 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; + case Symbol: String_appendAll(buf, _get(obj, Symbol,name)); break; + case Primitive: { + String_appendAll(buf, "'); + break; + } #if PRIMCLOSURE - case Lambda: { - String_appendAll(buf, "<>"); - 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, "<>"); - 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; - } + case Lambda: { + String_appendAll(buf, "<>"); + 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, "<>"); + 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; - oop proto = obj; - oop name = nil; - do { - ++level; - name = Object_getLocal(proto, prop_name); - if (nil != name) break; - proto = _getDelegate(proto); - } while (is(Object, proto)); - 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, '>'); - if (!indent) break; - for (;;) { - int psize = _get(obj, Object,psize); - struct property *props = _get(obj, Object,properties); - 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, " | "); - String_appendAll(buf, " "); - printOn(buf, props[i].key, indent+1); - String_appendAll(buf, ": "); - printOn(buf, props[i].val, indent+1); - } - int isize = _get(obj, Object,isize); - 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, " | "); - String_format(buf, " %d: ", i); - printOn(buf, indexed[i], indent+1); - } - oop delegate = _getDelegate(obj); - if (nil == delegate) break; - if (nil != Object_getLocal(delegate, prop_name)) break; - obj = delegate; - // ++indent; - String_appendAll(buf, " =>"); - } - break; - } - default: - assert(!"this cannot happen"); + case Object: { + int level = 0; + oop proto = obj; + oop name = nil; + do { + ++level; + name = Object_getLocal(proto, prop_name); + if (nil != name) break; + proto = _getDelegate(proto); + } while (is(Object, proto)); + 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, '>'); + if (!indent) break; + for (;;) { + int psize = _get(obj, Object,psize); + struct property *props = _get(obj, Object,properties); + 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, " | "); + String_appendAll(buf, " "); + printOn(buf, props[i].key, indent+1); + String_appendAll(buf, ": "); + printOn(buf, props[i].val, indent+1); + } + int isize = _get(obj, Object,isize); + 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, " | "); + String_format(buf, " %d: ", i); + printOn(buf, indexed[i], indent+1); + } + oop delegate = _getDelegate(obj); + if (nil == delegate) break; + if (nil != Object_getLocal(delegate, prop_name)) break; + obj = delegate; + // ++indent; + String_appendAll(buf, " =>"); + } + break; + } + default: + assert(!"this cannot happen"); } return buf; } @@ -951,54 +951,54 @@ oop printOn(oop buf, oop obj, int indent) oop storeOn(oop buf, oop obj, int indent) { switch (getType(obj)) { - case String: { - String_append(buf, '"'); - char *str = _get(obj, String,value); - int len = _get(obj, String,length); - for (int i = 0; i < len; ++i) { - int c = str[i]; - switch (c) { - case '\a': String_appendAll(buf, "\\a"); break; - case '\b': String_appendAll(buf, "\\b"); break; - case '\f': String_appendAll(buf, "\\f"); break; - case '\n': String_appendAll(buf, "\\n"); break; - case '\r': String_appendAll(buf, "\\r"); break; - case '\t': String_appendAll(buf, "\\t"); break; - case '\v': String_appendAll(buf, "\\v"); break; - case '"': String_appendAll(buf, "\\\""); break; - case '\\': String_appendAll(buf, "\\\\"); break; - default: - if (c < ' ' || c > '~') String_format(buf, "\\%04o", 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); + case String: { + String_append(buf, '"'); + char *str = _get(obj, String,value); + int len = _get(obj, String,length); + for (int i = 0; i < len; ++i) { + int c = str[i]; + switch (c) { + case '\a': String_appendAll(buf, "\\a"); break; + case '\b': String_appendAll(buf, "\\b"); break; + case '\f': String_appendAll(buf, "\\f"); break; + case '\n': String_appendAll(buf, "\\n"); break; + case '\r': String_appendAll(buf, "\\r"); break; + case '\t': String_appendAll(buf, "\\t"); break; + case '\v': String_appendAll(buf, "\\v"); break; + case '"': String_appendAll(buf, "\\\""); break; + case '\\': String_appendAll(buf, "\\\\"); break; + default: + if (c < ' ' || c > '~') String_format(buf, "\\%04o", 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; } @@ -1072,11 +1072,11 @@ void fatal(char *fmt, ...) fprintf(stderr, "\n"); va_end(ap); if (is(Object, trace)) { - int w = 1 + log10(_get(trace, Object,isize)); - for (int i = _get(trace, Object,isize); i--;) { - printf("%*d: ", w, i); - codeln(_get(trace, Object,indexed)[i], 1); - } + int w = 1 + log10(_get(trace, Object,isize)); + for (int i = _get(trace, Object,isize); i--;) { + printf("%*d: ", w, i); + codeln(_get(trace, Object,indexed)[i], 1); + } } exit(1); } @@ -1090,9 +1090,9 @@ void sigint(int sig) typedef struct Input { struct Input *next; - char *text; - int size; - int position; + char *text; + int size; + int position; } Input; Input *newInput(void) @@ -1109,16 +1109,16 @@ Input *makeInput(void) #define YYSTYPE oop -#define YY_MALLOC(C, N) GC_malloc(N) -#define YY_REALLOC(C, P, N) GC_realloc(P, N) -#define YY_FREE(C, P) GC_free(P) +#define YY_MALLOC(C, N) GC_malloc(N) +#define YY_REALLOC(C, P, N) GC_realloc(P, N) +#define YY_FREE(C, P) GC_free(P) -#define YY_INPUT(buf, result, max_size) \ - { \ - result= (input->position >= input->size) \ - ? 0 \ - : ((*(buf)= input->text[input->position++]), 1); \ - /* printf("<%c>", *(buf)); */ \ +#define YY_INPUT(buf, result, max_size) \ + { \ + result= (input->position >= input->size) \ + ? 0 \ + : ((*(buf)= input->text[input->position++]), 1); \ + /* printf("<%c>", *(buf)); */ \ } YYSTYPE yysval = 0; @@ -1126,7 +1126,7 @@ YYSTYPE yysval = 0; oop eval(oop exp, oop env); oop evargs(oop list, oop env); -oop Object_eval(oop exp, oop env) { return exp; } +oop Object_eval(oop exp, oop env) { return exp; } void Object_codeOn(oop exp, oop str, oop env) { @@ -1145,7 +1145,7 @@ 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)); + oop o = newInteger(p); assert(p == _integerValue(o)); return o; } @@ -1154,7 +1154,7 @@ 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); } +void RefVar_codeOn(oop exp, oop str, oop env) { printOn(str, Object_get(exp, sym_name), 0); } oop newGetVar(oop name) { @@ -1163,9 +1163,9 @@ oop newGetVar(oop name) return o; } -oop GetVar_eval(oop exp, oop env) { return getvar(env, Object_get(exp, sym_name)); } +oop GetVar_eval(oop exp, oop env) { return getvar(env, Object_get(exp, sym_name)); } -void GetVar_codeOn(oop exp, oop str, oop env) { printOn(str, Object_get(exp, sym_name), 0); } +void GetVar_codeOn(oop exp, oop str, oop env) { printOn(str, Object_get(exp, sym_name), 0); } oop newSetVar(oop name, oop expr) { @@ -1177,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); } @@ -1200,7 +1200,7 @@ oop newRefProp(oop object, oop key) oop RefProp_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 mkptr(Object_ref(obj, key)); } @@ -1222,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); } @@ -1245,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); } @@ -1255,13 +1255,13 @@ void SetProp_codeOn(oop exp, oop str, oop env) codeOn(str, Object_get(exp, sym_object), 0); oop key = Object_get(exp, sym_key); if (is(Symbol,key)) { - String_appendAll(str, "."); - printOn(str, key, 0); + String_appendAll(str, "."); + printOn(str, key, 0); } else { - String_appendAll(str, "["); - codeOn(str, key, 0); - String_appendAll(str, "]"); + String_appendAll(str, "["); + codeOn(str, key, 0); + String_appendAll(str, "]"); } String_appendAll(str, " = "); codeOn(str, Object_get(exp, sym_value ), 0); @@ -1303,17 +1303,17 @@ 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; - } + 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); + oop *ref = Object_refLocal(obj, ind); + if (ref) return mkptr(ref); } error: fatal("[]: %s is not an object", storeString(obj, 0)); @@ -1341,13 +1341,13 @@ oop GetArray_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: 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)); - } + int index = _integerValue(ind); + switch (getType(obj)) { + 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)); + } } if (!is(Object, obj)) fatal("[]: %s is not an object", storeString(obj, 0)); return Object_getLocal(obj, ind); @@ -1376,14 +1376,14 @@ oop SetArray_eval(oop exp, oop env) oop ind = eval(Object_get(exp, sym_index ), env); oop val = eval(Object_get(exp, sym_value ), env); if (isInteger(ind)) { - int index = _integerValue(ind); - switch (getType(obj)) { - case String: *String_aref(obj, index) = integerValue(val, "[]="); break; - case Symbol: *Symbol_aref(obj, index) = integerValue(val, "[]="); break; - case Object: *Object_aref(obj, index) = val; break; - default: fatal("[]=: %s is not indexable", storeString(obj, 0)); - } - return val; + int index = _integerValue(ind); + switch (getType(obj)) { + case String: *String_aref(obj, index) = integerValue(val, "[]="); break; + case Symbol: *Symbol_aref(obj, index) = integerValue(val, "[]="); break; + case Object: *Object_aref(obj, index) = val; break; + default: fatal("[]=: %s is not indexable", storeString(obj, 0)); + } + return val; } if (!is(Object, obj)) fatal("[]=: %s is not an object", storeString(obj, 0)); return Object_put(obj, ind, val); @@ -1409,10 +1409,10 @@ oop newCall(oop function, oop arguments) oop newApply(oop function, oop arguments) { if (_getDelegate(function) == pGetVar) { - oop symbol = Object_get(function, sym_name); - assert(is(Symbol, symbol)); - oop macro = Object_getLocal(macros, symbol); - if (nil != macro) return apply(macro, nil, arguments, nil); + oop symbol = Object_get(function, sym_name); + assert(is(Symbol, symbol)); + oop macro = Object_getLocal(macros, symbol); + if (nil != macro) return apply(macro, nil, arguments, nil); } return newCall(function, arguments); } @@ -1429,7 +1429,7 @@ int isFixed(oop func) 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); } @@ -1438,20 +1438,20 @@ 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) { - if (i) String_appendAll(str, ", "); - codeOn(str, indexed[i], 0); + 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) { - if (prop_delegate == kvs[j].key && pObject == kvs[j].val) continue; - if (i++) String_appendAll(str, ", "); - printOn(str, kvs[j].key, 0); - String_appendAll(str, ": "); - codeOn(str, kvs[j].val, 0); + 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); + String_appendAll(str, ": "); + codeOn(str, kvs[j].val, 0); } String_appendAll(str, end); } @@ -1465,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); @@ -1529,8 +1529,8 @@ void Break_codeOn(oop exp, oop str, oop env) String_appendAll(str, "break"); oop value = Object_get(exp, sym_value); if (nil != value) { - String_appendAll(str, " "); - codeOn(str, value, 0); + String_appendAll(str, " "); + codeOn(str, value, 0); } } @@ -1563,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; } @@ -1603,22 +1603,22 @@ void Closure_codeOn(oop exp, oop str, oop env) #endif // !PRIMCLOSURE -#define doBinops(_) \ - _(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 doBinops(_) \ + _(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 { @@ -1644,14 +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) { - 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)); + 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; } @@ -1659,7 +1659,7 @@ oop shl(oop l, oop r) { int tl = getType(l), tr = getType(r); if (Integer == tl && Integer == tr) - return newInteger(_integerValue(l) << _integerValue(r)); + return newInteger(_integerValue(l) << _integerValue(r)); fatal("<<: illegal operand types %s and %s", getTypeName(l), getTypeName(r)); return 0; } @@ -1668,19 +1668,19 @@ oop shr(oop l, oop r) { int tl = getType(l), tr = getType(r); if (Integer == tl && Integer == tr) - return newInteger(_integerValue(l) >> _integerValue(r)); + return newInteger(_integerValue(l) >> _integerValue(r)); fatal(">>: illegal operand types %s and %s", getTypeName(l), getTypeName(r)); return 0; } -#define binop(NAME, OP) \ -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)); \ - fatal(#OP": illegal operand types %s and %s", getTypeName(l), getTypeName(r)); \ - return 0; \ +#define binop(NAME, OP) \ +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)); \ + fatal(#OP": illegal operand types %s and %s", getTypeName(l), getTypeName(r)); \ + return 0; \ } binop(add, +); @@ -1693,10 +1693,10 @@ oop quo(oop l, oop r) { int tl = getType(l), tr = getType(r); if (Integer == tl && Integer == tr) { - long vl = _integerValue(l), vr = _integerValue(r); - ldiv_t qr = ldiv(vl, vr); - if (!qr.rem) return newInteger(qr.quot); // division was exact - return newFloat((double)vl / (double)vr); + long vl = _integerValue(l), vr = _integerValue(r); + ldiv_t qr = ldiv(vl, vr); + if (!qr.rem) return newInteger(qr.quot); // division was exact + return newFloat((double)vl / (double)vr); } if (Float == tl || Float == tr) return newFloat (floatValue(l, "/") / floatValue(r, "/")); fatal("/: illegal operand types %s and %s", getTypeName(l), getTypeName(r)); @@ -1706,116 +1706,116 @@ 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; } -#define newBoolean(TF) ((TF) ? sym_t : nil) +#define newBoolean(TF) ((TF) ? sym_t : nil) oop Binop_eval(oop exp, oop env) -{ assert(_get(exp, Object,isize) == 2); +{ 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]; enum binop code = integerValue(op, "Binop.operation"); lhs = eval(lhs, env); switch (code) { - case opLogOr: return nil != lhs ? lhs : eval(rhs, env); - case opLogAnd: return nil == lhs ? lhs : eval(rhs, env); - default: break; + case opLogOr: return nil != lhs ? lhs : eval(rhs, env); + case opLogAnd: return nil == lhs ? lhs : eval(rhs, env); + default: break; } 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 opLessEq: return newBoolean(cmp(lhs, rhs, "<=") <= 0); - case opGrtrEq: 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); - 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"); - } - } + 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 opLessEq: return newBoolean(cmp(lhs, rhs, "<=") <= 0); + case opGrtrEq: 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); + 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; @@ -1823,22 +1823,22 @@ oop Binop_eval(oop exp, oop env) void Binop_codeOn(oop exp, oop str, oop env) { - 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); + 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); + printOn(str, exp, 0); } } -#define doUnyops(_) \ +#define doUnyops(_) \ _(opNot, !) _(opCom, ~) _(opNeg, -) _(opQuasiquote, `) _(opUnquote, @) #define defineUnyop(NAME, OP_) NAME, @@ -1868,26 +1868,26 @@ oop newUnyop(int operation, oop value) 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]; - 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) - 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) - if (kvs[i].key != prop_delegate) - Object_put(clone, kvs[i].key, quasiclone(kvs[i].val, env)); - oop delegate = _getDelegate(exp); - if (nil != delegate) // always shallow copied - Object_put(clone, prop_delegate, delegate); - return clone; + if (pUnyop == _getDelegate(exp)) { + 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) + 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) + if (kvs[i].key != prop_delegate) + Object_put(clone, kvs[i].key, quasiclone(kvs[i].val, env)); + oop delegate = _getDelegate(exp); + if (nil != delegate) // always shallow copied + Object_put(clone, prop_delegate, delegate); + return clone; } return exp; } @@ -1896,9 +1896,9 @@ oop neg(oop n) { int tn = getType(n); switch (tn) { - case Integer: return newInteger(-_integerValue(n)); - case Float: return newFloat (-_floatValue (n)); - default: break; + case Integer: return newInteger(-_integerValue(n)); + case Float: return newFloat (-_floatValue (n)); + default: break; } fatal("-: illegal operand type %s", getTypeName(n)); return 0; @@ -1908,15 +1908,15 @@ oop com(oop n) { int tn = getType(n); switch (tn) { - case Integer: return newInteger(~_integerValue(n)); - default: break; + case Integer: return newInteger(~_integerValue(n)); + default: break; } fatal("~: illegal operand type %s", getTypeName(n)); return 0; } oop Unyop_eval(oop exp, oop env) -{ assert(_get(exp, Object,isize) == 1); +{ assert(_get(exp, Object,isize) == 1); oop op = Object_get(exp, sym_operation); oop value = _get(exp, Object,indexed)[0]; enum unyop code = integerValue(op, "Unyop.operation"); @@ -1924,17 +1924,17 @@ 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; } void Unyop_codeOn(oop exp, oop str, oop env) -{ assert(_get(exp, Object,isize) == 1); +{ assert(_get(exp, Object,isize) == 1); oop op = Object_get(exp, sym_operation); oop value = _get(exp, Object,indexed)[0]; enum unyop code = integerValue(op, "Unyop.operation"); @@ -1960,26 +1960,26 @@ 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))); + Object_put(env, indexed[i], (result = eval(indexed[i+1], env))); return result; } void Let_codeOn(oop exp, oop str, oop env) { - oop keyvals = Object_getLocal(exp, sym_keyvals); + oop 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, ", "); - codeOn(str, indexed[i], 0); - String_appendAll(str, " = "); - codeOn(str, indexed[i+1], 0); + if (i) String_appendAll(str, ", "); + codeOn(str, indexed[i], 0); + String_appendAll(str, " = "); + codeOn(str, indexed[i+1], 0); } } @@ -1995,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); } @@ -2010,8 +2010,8 @@ void If_codeOn(oop exp, oop str, oop env) String_appendAll(str, ") "); codeOn(str, consequent, 0); if (nil != alternate) { - String_appendAll(str, " else "); - codeOn(str, alternate, 0); + String_appendAll(str, " else "); + codeOn(str, alternate, 0); } } @@ -2019,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; } @@ -2035,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, ") "); @@ -2052,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; } @@ -2072,22 +2072,22 @@ 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 -# define LOOP() \ - PASTE(continue,__LINE__): \ - switch (nlrPush()) { \ - case NLR_CONTINUE: nlrPop(); goto PASTE(continue, __LINE__); \ - case NLR_BREAK: return nlrPop(); \ - case NLR_RETURN: nlrReturn(nlrPop(), NLR_RETURN); \ +# define LOOP() \ + PASTE(continue,__LINE__): \ + switch (nlrPush()) { \ + case NLR_CONTINUE: nlrPop(); goto PASTE(continue, __LINE__); \ + case NLR_BREAK: return nlrPop(); \ + case NLR_RETURN: nlrReturn(nlrPop(), NLR_RETURN); \ } # define DONE() nlrPop() @@ -2100,19 +2100,19 @@ 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 (;;) { - if (nil == eval(condition, env2)) break; - result = eval(body, env2); + if (nil == eval(condition, env2)) break; + result = eval(body, env2); doContinue: - eval(update, env2); + eval(update, env2); } DONE(); return result; @@ -2122,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, "; "); @@ -2139,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; } @@ -2147,41 +2147,41 @@ 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)) { - long i = -1, limit = _integerValue(vals); - LOOP(); - while (++i < limit) { - Object_put(env2, identifier, newInteger(i)); - result = eval(body, env2); - } - DONE(); - return result; + long i = -1, limit = _integerValue(vals); + LOOP(); + while (++i < limit) { + Object_put(env2, identifier, newInteger(i)); + result = eval(body, env2); + } + DONE(); + return result; } if (is(String, vals)) { - int len = _get(vals, String,length); - char *val = _get(vals, String,value); - int i = -1; - LOOP(); - while (++i < len) { - Object_put(env2, identifier, newInteger(val[i])); - result = eval(body, env2); - } - DONE(); - return result; + int len = _get(vals, String,length); + char *val = _get(vals, String,value); + int i = -1; + LOOP(); + while (++i < len) { + Object_put(env2, identifier, newInteger(val[i])); + result = eval(body, env2); + } + DONE(); + return result; } 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]); - result = eval(body, env2); + Object_put(env2, identifier, indexed[i]); + result = eval(body, env2); } DONE(); return result; @@ -2191,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 "); @@ -2204,31 +2204,31 @@ 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 (;;) { - start += step; - Object_put(env2, identifier, newInteger(start)); - result = eval(body, env2); - if (start == stop) break; + start += step; + Object_put(env2, identifier, newInteger(start)); + result = eval(body, env2); + if (start == stop) break; } DONE(); return result; @@ -2237,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 "); @@ -2264,20 +2264,20 @@ 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) - Object_push(clone, eval(indexed[i], env)); + 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) - Object_put(clone, kvs[i].key, eval(kvs[i].val, env)); + 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); if (nil != delegate) - Object_put(clone, prop_delegate, eval(delegate, env)); + Object_put(clone, prop_delegate, eval(delegate, env)); # endif return clone; } @@ -2286,16 +2286,16 @@ 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) - Object_push(clone, eval(indexed[i], env)); + 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) - Object_put(clone, kvs[i].key, eval(kvs[i].val, env)); + 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; } @@ -2303,24 +2303,24 @@ 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) { - if (i) String_appendAll(str, ", "); - codeOn(str, indexed[i], 0); + 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) { - if (i++) String_appendAll(str, ", "); - codeOn(str, kvs[j].key, 0); - String_appendAll(str, ": "); - codeOn(str, kvs[j].val, 0); + 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 @@ -2329,266 +2329,266 @@ void Literal_codeOn(oop exp, oop str, oop env) %} -start = - ( s:stmt { yysval = s } - | !. { yysval = 0 } - | < (!EOL .)* > { fatal("syntax error near: %s", yytext) } - ) - -stmt = LET l:mklet k:id ASSIGN v:expr { Let_append(l, k, v) } - ( COMMA k:id ASSIGN v:expr { Let_append(l, k, v) } - )* SEMI { $$ = l } - | WHILE LPAREN c:expr RPAREN s:stmt { $$ = newWhile(c, s) } - | IF LPAREN c:expr RPAREN s:stmt - ( ELSE t:stmt { $$ = newIf(c, s, t ) } - | { $$ = newIf(c, s, nil) } - ) - | CONT EOS { $$ = newContinue() } - | BREAK e:expr EOS { $$ = newBreak(e) } - | BREAK EOS { $$ = newBreak(nil) } - | RETURN e:expr EOS { $$ = newReturn(e) } - | RETURN EOS { $$ = newReturn(nil) } - | 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) } - | 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)) } - | v:proto DOT i:id p:params b:block { $$ = newSetProp(v, i, newLambda(p, b)) } - | b:block { $$ = newBlock(b) } - | e:expr EOS { $$ = e } - -mklet = { $$ = newLet() } - -proto = v:var ( DOT j:id !LPAREN { v = newGetProp(v, j) } - )* { $$ = v } - -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) } - ) - | 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) } - )* { $$ = l } - -logand = l:bitor ( ANDAND r:bitor { l = newBinop(opLogAnd, l, r) } - )* { $$ = l } - -bitor = l:bitxor ( OR r:bitxor { l = newBinop(opBitOr, l, r) } - )* { $$ = l } - -bitxor = l:bitand ( XOR r:bitand { l = newBinop(opBitXor, l, r) } - )* { $$ = l } - -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 } - -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 } - -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 } - -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 - -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) } - ) )* )? RPAREN { $$ = a } - -params = LPAREN p:mkobj - ( i:id { Object_push(p, i) } - ( COMMA i:id { Object_push(p, i) } - )* )? RPAREN { $$ = p } - -mkobj = { $$ = new(pObject) } +start = - ( s:stmt { yysval = s } + | !. { yysval = 0 } + | < (!EOL .)* > { fatal("syntax error near: %s", yytext) } + ) + +stmt = LET l:mklet k:id ASSIGN v:expr { Let_append(l, k, v) } + ( COMMA k:id ASSIGN v:expr { Let_append(l, k, v) } + )* SEMI { $$ = l } + | WHILE LPAREN c:expr RPAREN s:stmt { $$ = newWhile(c, s) } + | IF LPAREN c:expr RPAREN s:stmt + ( ELSE t:stmt { $$ = newIf(c, s, t ) } + | { $$ = newIf(c, s, nil) } + ) + | CONT EOS { $$ = newContinue() } + | BREAK e:expr EOS { $$ = newBreak(e) } + | BREAK EOS { $$ = newBreak(nil) } + | RETURN e:expr EOS { $$ = newReturn(e) } + | RETURN EOS { $$ = newReturn(nil) } + | 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) } + | 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)) } + | v:proto DOT i:id p:params b:block { $$ = newSetProp(v, i, newLambda(p, b)) } + | b:block { $$ = newBlock(b) } + | e:expr EOS { $$ = e } + +mklet = { $$ = newLet() } + +proto = v:var ( DOT j:id !LPAREN { v = newGetProp(v, j) } + )* { $$ = v } + +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) } + ) + | 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) } + )* { $$ = l } + +logand = l:bitor ( ANDAND r:bitor { l = newBinop(opLogAnd, l, r) } + )* { $$ = l } + +bitor = l:bitxor ( OR r:bitxor { l = newBinop(opBitOr, l, r) } + )* { $$ = l } + +bitxor = l:bitand ( XOR r:bitand { l = newBinop(opBitXor, l, r) } + )* { $$ = l } + +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 } + +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 } + +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 } + +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 + +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) } + ) )* )? RPAREN { $$ = a } + +params = LPAREN p:mkobj + ( i:id { Object_push(p, i) } + ( COMMA i:id { Object_push(p, i) } + )* )? RPAREN { $$ = p } + +mkobj = { $$ = new(pObject) } primary = nil | number | string | symbol | var | lambda | subexpr | literal -lambda = p:params b:block { $$ = newLambda(p, b) } +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 - ( ( 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) } - -block = LBRACE b:mkobj - ( e:stmt { Object_push(b, e) } - )* RBRACE { $$ = b } - -nil = NIL { $$ = nil } - -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)) } - | "0" [bB] < BIGIT+ > - { $$ = newInteger(strtol(yytext, 0, 2)) } - | "0" [xX] < HIGIT+ > - { $$ = newInteger(strtol(yytext, 0, 16)) } - | "0" < OIGIT* > - { $$ = newInteger(strtol(yytext, 0, 8)) } - | < DIGIT+ > - { $$ = newInteger(strtol(yytext, 0, 10)) } - -string = '"' < ( !'"' . )* > '"' - { $$ = newStringEscaped(yytext) } - | "'" < ( !"'" . )* > "'" - { $$ = newStringEscaped(yytext) } - -symbol = HASH i:id { $$ = i } - -var = i:id { $$ = newGetVar(i) } - -id = < LETTER ALNUM* > - { $$ = intern(yytext) } - -BIGIT = [0-1] -OIGIT = [0-7] -DIGIT = [0-9] -HIGIT = [0-9A-Fa-f] -LETTER = [A-Za-z_] -ALNUM = LETTER | DIGIT -SIGN = [-+] -EXP = [eE] SIGN DIGIT+ - -- = SPACE* - -SPACE = [ \t] | EOL | '//' (!EOL .)* -EOL = [\n\r] { ++lineno } - -NIL = "nil" !ALNUM - -WHILE = "while" !ALNUM - -IF = "if" !ALNUM - -ELSE = "else" !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 = "&&" ![=] - -OR = "|" ![|=] - -OREQ = "|=" - -XOR = "^" ![=] - -XOREQ = "^=" - -AND = "&" ![&=] - -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 = "~" - + ( ( 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) } + +block = LBRACE b:mkobj + ( e:stmt { Object_push(b, e) } + )* RBRACE { $$ = b } + +nil = NIL { $$ = nil } + +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)) } + | "0" [bB] < BIGIT+ > - { $$ = newInteger(strtol(yytext, 0, 2)) } + | "0" [xX] < HIGIT+ > - { $$ = newInteger(strtol(yytext, 0, 16)) } + | "0" < OIGIT* > - { $$ = newInteger(strtol(yytext, 0, 8)) } + | < DIGIT+ > - { $$ = newInteger(strtol(yytext, 0, 10)) } + +string = '"' < ( !'"' . )* > '"' - { $$ = newStringEscaped(yytext) } + | "'" < ( !"'" . )* > "'" - { $$ = newStringEscaped(yytext) } + +symbol = HASH i:id { $$ = i } + +var = i:id { $$ = newGetVar(i) } + +id = < LETTER ALNUM* > - { $$ = intern(yytext) } + +BIGIT = [0-1] +OIGIT = [0-7] +DIGIT = [0-9] +HIGIT = [0-9A-Fa-f] +LETTER = [A-Za-z_] +ALNUM = LETTER | DIGIT +SIGN = [-+] +EXP = [eE] SIGN DIGIT+ + +- = SPACE* + +SPACE = [ \t] | EOL | '//' (!EOL .)* +EOL = [\n\r] { ++lineno } + +NIL = "nil" !ALNUM - +WHILE = "while" !ALNUM - +IF = "if" !ALNUM - +ELSE = "else" !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 = "&&" ![=] - +OR = "|" ![|=] - +OREQ = "|=" - +XOR = "^" ![=] - +XOREQ = "^=" - +AND = "&" ![&=] - +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 = "~" - %%; -#define SEND(RCV, MSG) ({ \ - oop _rcv = RCV; \ - oop _fun = Object_get(_rcv, sym_##MSG); \ - get(_fun, Primitive,function)(_fun, _rcv, nil, nil); \ - }) +#define SEND(RCV, MSG) ({ \ + oop _rcv = RCV; \ + oop _fun = Object_get(_rcv, sym_##MSG); \ + get(_fun, Primitive,function)(_fun, _rcv, nil, nil); \ + }) oop sym_x = 0; oop sym_y = 0; @@ -2604,44 +2604,44 @@ oop apply(oop func, oop self, oop args, oop env) { int functype = getType(func); if (Primitive == functype) - return _get(func, Primitive,function)(func, self, args, env); + return _get(func, Primitive,function)(func, self, args, 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); + 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); #else - 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); + 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); #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"); - case NLR_BREAK: fatal("break outside loop"); - case NLR_RETURN: return nlrPop(); + case NLR_CONTINUE: fatal("continue outside loop"); + case NLR_BREAK: fatal("break outside loop"); + case NLR_RETURN: return nlrPop(); } # 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) - result = eval(exprs[i], args); + Object_put(args, pparam[i], i < nargs ? pargs[i] : nil); + for (int i = 0; i < size; ++i) + result = eval(exprs[i], args); # if NONLOCAL nlrPop(); # endif @@ -2649,13 +2649,13 @@ oop apply(oop func, oop self, oop args, oop env) } oop getArg(oop args, int index, char *who) -{ assert(is(Object, args)); +{ assert(is(Object, args)); if (index >= _get(args, Object,isize)) fatal("%s: too few arguments", who); return _get(args, Object,indexed)[index]; } oop getArgType(oop args, int index, int type, char *who) -{ assert(is(Object, args)); +{ assert(is(Object, args)); oop arg = getArg(args, index, who); if (type != getType(arg)) fatal("%s: non-%s arg: ", who, typeNames[type], storeString(arg, 0)); return arg; @@ -2666,15 +2666,15 @@ 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; } #else // !TYPECODES -#define defineEval(NAME) \ - static inline oop prim_##NAME##_eval(oop func, oop exp, oop args, oop env) { \ - return NAME##_eval(exp, env); \ +#define defineEval(NAME) \ + static inline oop prim_##NAME##_eval(oop func, oop exp, oop args, oop env) { \ + return NAME##_eval(exp, env); \ } doProtos(defineEval) @@ -2683,11 +2683,11 @@ doProtos(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; \ - } \ +#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(defineCodeOn) @@ -2697,11 +2697,11 @@ static inline oop evalobj(oop exp, oop env) { # if TYPECODES switch (getTypecode(exp)) { - case UNDEFINED_TYPECODE: - break; -# define defineEval(NAME) case t##NAME: return NAME##_eval(exp, env); - doProtos(defineEval); -# undef defineEval + case UNDEFINED_TYPECODE: + break; +# define defineEval(NAME) case t##NAME: return NAME##_eval(exp, env); + doProtos(defineEval); +# undef defineEval } # endif // TYPECODES @@ -2728,38 +2728,38 @@ 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) - indexed2[i] = eval(indexed[i], env); - for (int i = 0; i < psize; ++i) { - props2[i].key = props[i].key ; - props2[i].val = eval(props[i].val, env); + 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 ; + props2[i].val = eval(props[i].val, env); } return newObjectWith(isize, indexed2, psize, props2); } oop prim_new(oop func, oop self, oop args, oop env) -{ assert(is(Object, args)); +{ assert(is(Object, args)); _setDelegate(args, self); return args; } oop prim_push(oop func, oop self, oop args, oop env) -{ assert(is(Object, args)); +{ 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; } oop prim_pop(oop func, oop self, oop args, oop env) -{ assert(is(Object, args)); +{ assert(is(Object, args)); if (!is(Object, self)) fatal("pop: not an object"); int size = _get(self, Object,isize); if (size < 1) fatal("pop: object is empty\n"); @@ -2769,7 +2769,7 @@ oop prim_pop(oop func, oop self, oop args, oop env) } oop prim_length(oop func, oop self, oop args, oop env) -{ assert(is(Object, args)); +{ assert(is(Object, args)); if (!is(Object, self)) fatal("length: not an object"); return newInteger(_get(self, Object,isize)); } @@ -2781,26 +2781,26 @@ oop prim_keys(oop func, oop self, oop args, oop env) 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; - } + 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; - } + 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 } return keys; @@ -2813,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; } @@ -2827,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; } @@ -2887,10 +2887,10 @@ oop prim_len(oop func, oop self, oop args, oop env) if (1 != argc) fatal("len: 1 argument expected"); oop arg = _get(args, Object,indexed)[0]; switch (getType(arg)) { - case String: return newInteger(_get(arg, String,length)); - case Symbol: return newInteger(strlen(_get(arg, Symbol,name))); - case Object: return newInteger(_get(arg, Object,isize)); - default: break; + case String: return newInteger(_get(arg, String,length)); + case Symbol: return newInteger(strlen(_get(arg, Symbol,name))); + case Object: return newInteger(_get(arg, Object,isize)); + default: break; } return newInteger(0); } @@ -2909,8 +2909,8 @@ 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) - String_append(str, integerValue(_get(args, Object,indexed)[i], "chr")); + for (int i = 0; i < argc; ++i) + String_append(str, integerValue(_get(args, Object,indexed)[i], "chr")); return str; } @@ -2919,11 +2919,11 @@ void readFile(FILE *file, char **textp, int *sizep) size_t size = 0; char *text = xmallocAtomic(4096); for (;;) { - ssize_t n = fread(text+size, 1, 4096, file); - if (n < 1) break; - size += n; - if (n < 4096) break; - text = xrealloc(text, size + 4096); + ssize_t n = fread(text+size, 1, 4096, file); + if (n < 1) break; + size += n; + if (n < 4096) break; + text = xrealloc(text, size + 4096); } *textp = text; *sizep = size; @@ -2933,16 +2933,16 @@ 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) { - 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"); - if (!file) fatal("%s: %s", _get(name, String,value), strerror(errno)); - char *text = 0; - int tlen = 0; - readFile(file, &text, &tlen); - fclose(file); - String_appendAllLen(str, text, tlen); + 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"); + if (!file) fatal("%s: %s", _get(name, String,value), strerror(errno)); + char *text = 0; + int tlen = 0; + readFile(file, &text, &tlen); + fclose(file); + String_appendAllLen(str, text, tlen); } return str; } @@ -2951,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; @@ -2966,22 +2966,22 @@ oop replFile(FILE *in) oop result = nil; # if NONLOCAL switch (nlrPush()) { - case NLR_CONTINUE: fatal("continue outside loop"); - case NLR_BREAK: fatal("break outside loop"); - case NLR_RETURN: fatal("return outside function"); + case NLR_CONTINUE: fatal("continue outside loop"); + case NLR_BREAK: fatal("break outside loop"); + case NLR_RETURN: fatal("return outside function"); } # endif while (yyparse() && yysval) { - if (opt_v) { - printf(">>> "); - (opt_d ? println : codeln)(yysval, opt_v >2); - } - result = eval(yysval, nil); - if (opt_v) { - printf("==> "); - if (opt_v >= 3) storeln(result, 1); - else if (opt_v >= 1) storeln(result, 0); - } + if (opt_v) { + printf(">>> "); + (opt_d ? println : codeln)(yysval, opt_v >2); + } + result = eval(yysval, nil); + if (opt_v) { + printf("==> "); + if (opt_v >= 3) storeln(result, 1); + else if (opt_v >= 1) storeln(result, 0); + } } # if NONLOCAL nlrPop(); @@ -3006,19 +3006,19 @@ 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 pObject = nil; -# define defineProto(NAME) \ - p##NAME = new(pObject); \ - Object_put(p##NAME, prop_name, intern(#NAME)); \ +# define defineProto(NAME) \ + p##NAME = new(pObject); \ + Object_put(p##NAME, prop_name, intern(#NAME)); \ _set(intern(#NAME), Symbol,value, p##NAME); doProtos(defineProto); @@ -3026,15 +3026,15 @@ int main(int argc, char **argv) # undef defineProto - Object_put(pObject, prop_eval, newPrimitive(prim___eval__)); // inherited by all objects + Object_put(pObject, prop_eval, newPrimitive(prim___eval__)); // inherited by all objects #if TYPECODES -# define defineEvaluator(NAME) \ +# define defineEvaluator(NAME) \ _set(intern(#NAME), Symbol,typecode, t##NAME); #else // !TYPECODES -# define defineEvaluator(NAME) \ +# define defineEvaluator(NAME) \ Object_put(p##NAME, prop_eval, newPrimitive(prim_##NAME##_eval)); #endif // !TYPECODES @@ -3043,35 +3043,35 @@ int main(int argc, char **argv) # undef defineEvaluator -# define defineCodeOn(NAME) \ +# define defineCodeOn(NAME) \ Object_put(p##NAME, prop_codeon, newPrimitive(prim_##NAME##_codeOn)); 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); @@ -3079,25 +3079,30 @@ int main(int argc, char **argv) int repled = 0; - for (int argn = 1; argn < argc; ++argn) { - char *arg = argv[argn]; - if ('-' == *arg) { - while (*++arg) { - switch (*arg) { - case 'O': ++opt_O; break; - case 'd': ++opt_d, ++opt_v; break; - case 'v': ++opt_v; break; - default: fatal("unknown command-line option '%c'", *arg); - } - } - } - else { - replPath(arg); - ++repled; - } + for (int argn = 1; argn < argc; ++argn) { + char *arg = argv[argn]; + if ('-' == *arg) { + while (*++arg) { + switch (*arg) { + case 'O': ++opt_O; break; + case 'd': ++opt_d, ++opt_v; break; + case 'v': ++opt_v; break; + default: fatal("unknown command-line option '%c'", *arg); + } + } + } + else { + replPath(arg); + ++repled; + } } if (!repled) replFile(stdin); return 0; } + +// Local Variables: +// eval: (setq indent-tabs-mode nil) +// eval: (untabify (point-min) (point-max)) +// End: