piumarta
/
minproto
1
0
Разклонения 1
Код Задачи 0 Заявки за сливане 0 Версии 0 Уики Activity
Преглед на файлове

Primitives have correct names. Primitive Object.keys() returns properties that do not begin with "__". Add method Object.allKeys() that returns properties that do not begin with "__". Add method Object.sorted() to sort indexable elements. Add function sorted() for String and Object. Relations do not consider strings and symbols to be comparable. Printing strings does not include quotation marks at indentation levels 0 and 1. Printing strings escapes control characters at indentation levels other than 0 and 1. Rename SetVar.expr to SetVar.value to be consistent with SetProp and SetArray. Add RefVar, RefProp, RefArray that compute address of assignable value. Add Binops for autoincrement and assignment operators. Any expression can be the subject of increment or assignment operator. Enforce lvalue for increment and assignment operators by semanic check, not in syntax. String literals can contain escaped quotation marks. Keyword:value pairs in parameter lists provide arbitray expressions as default parameter values. Evaluate and assign default parameters values in apply().

master
Ian Piumarta преди 1 година
родител
ff3dda9f83
ревизия
31e6d2ff3d
променени са 1 файла, в които са добавени 366 реда и са изтрити 194 реда
Разделен изглед
Diff Options
Показване на статистика Download Patch File Download Diff File
  1. +366
    -194
      minproto.leg

+ 366
- 194
minproto.leg Целия файл

@ -1,9 +1,11 @@
# minproto.leg -- minimal prototype langauge for semantic experiments
#
# last edited: 2024-05-14 12:14:06 by piumarta on zora
# last edited: 2024-05-15 19:13:04 by piumarta on debian
%{
;
//#define YY_DEBUG 1
#ifndef GC
# define GC 1 // do not fill memory with unreachable junk
#endif
@ -470,10 +472,10 @@ int stringLength(oop obj, char *who)
return 0;
}
oop newPrimitive(prim_t function)
oop newPrimitive(prim_t function, oop name)
{
oop obj = make(Primitive);
_set(obj, Primitive,name, 0);
_set(obj, Primitive,name, name);
_set(obj, Primitive,function, function);
return obj;
}
@ -783,6 +785,119 @@ oop newObjectWith(int isize, oop *indexed, int psize, struct property *propertie
return obj;
}
int isSpecial(oop key)
{
return is(Symbol, key) && !strncmp("__", _get(key, Symbol,name), 2);
}
oop keys(oop self, int all)
{
oop keys = new(pObject);
# if DELOPT
if (all && 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;
# if PRIMCLOSURE
case Lambda: {
Object_push(keys, sym_parameters);
Object_push(keys, sym_body);
break;
}
case Closure: {
Object_push(keys, sym_fixed);
Object_push(keys, sym_lambda);
Object_push(keys, sym_environment);
break;
}
# endif
case Object: {
int size = _get(self, Object,psize);
struct property *kvs = _get(self, Object,properties);
for (int i = 0; i < size; ++i) {
oop key = kvs[i].key;
if (all || !isSpecial(key)) Object_push(keys, key);
}
break;
}
}
return keys;
}
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));
return (intptr_t)l - (intptr_t)r;
}
#if defined (__linux__)
int objcmp(const void *a, const void *b, void *who) { return cmp(*(oop *)a, *(oop *)b, who); }
#else
int objcmp(void *who, const void *a, const void *b) { return cmp(*(oop *)a, *(oop *)b, who); }
#endif
oop sortObject(oop obj, char *who)
{ assert(is(Object, obj));
# if defined(__linux__)
qsort_r(_get(obj, Object,indexed), _get(obj, Object,isize), sizeof(oop), objcmp, "sort");
# else
qsort_r(_get(obj, Object,indexed), _get(obj, Object,isize), sizeof(oop), "sort", objcmp);
# endif
return obj;
}
int chrcmp(const void *a, const void *b) { return *(char *)a - *(char *)b; }
oop sortString(oop obj)
{ assert(is(String, obj));
qsort(_get(obj, String,value), _get(obj, String,length), 1, chrcmp);
return obj;
}
oop clone(oop obj) // shallow copy
{
switch (getType(obj)) {
case String: return newStringLen(_get(obj, String,value), _get(obj, String,length));
case Object:{
oop clone = new(_getDelegate(obj));
oop *elts = _get(obj, Object,indexed);
int size = _get(obj, Object,isize);
for (int i = 0; i < size; ++i) Object_push(clone, elts[i]);
struct property *kvs = _get(obj, Object,properties);
size = _get(obj, Object,psize);
for (int i = 0; i < size; ++i) {
oop key = kvs[i].key;
if (prop_delegate == key) continue;
Object_put(clone, key, kvs[i].val);
}
return clone;
}
default: break;
}
return obj;
}
oop sorted(oop obj, char *who)
{
switch (getType(obj)) {
case String: return sortString(clone(obj));
case Object: return sortObject(clone(obj), who);
default: break;
}
fatal("sort: cannot sort %s", getTypeName(obj));
return 0;
}
oop apply(oop func, oop self, oop args, oop env);
void codeParametersOn(oop str, oop object, char *begin, char *end)
@ -822,7 +937,7 @@ oop codeOn(oop str, oop obj, int indent)
case Symbol: String_format(str, "#%s", _get(obj, Symbol,name)); break;
case Primitive: {
String_appendAll(str, "<primitive ");
if (_get(obj, Primitive,name)) codeOn(str, _get(obj, Primitive,name), indent);
if (_get(obj, Primitive,name)) printOn(str, _get(obj, Primitive,name), 0);
else String_format(str, "%p", _get(obj, Primitive,function));
String_append(str, '>');
break;
@ -851,17 +966,97 @@ oop codeOn(oop str, oop obj, int indent)
return str;
}
void indentOn(oop buf, int indent)
{
if (indent < 1) return;
String_append(buf, '\n');
for (int i = indent; i--;) String_appendAll(buf, " | ");
String_appendAll(buf, " ");
}
void printObjectNameOn(oop buf, oop obj, int indent)
{
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, 0);
else String_appendAll(buf, "?");
for (int i = level; i--;) String_append(buf, '>');
}
enum {
NO_DELEGATE = -1,
NO_SPECIALS = -2,
};
int printObjectPropertiesOn(oop buf, oop obj, int indent)
{
oop names = sortObject(keys(obj, indent > 0), "print");
int nkeys = _get(names, Object,isize);
oop *elts = _get(names, Object,indexed);
int i = 0;
for (i = 0; i < nkeys; ++i) {
if (i && indent < 1) String_appendAll(buf, ", ");
oop key = elts[i];
if (prop_delegate == key) continue;
indentOn(buf, indent);
printOn(buf, key, 0);
String_appendAll(buf, ": ");
printOn(buf, Object_getLocal(obj, key), indent + (indent >= 0));
}
return i;
}
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 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: {
char *str = _get(obj, String,value);
int len = _get(obj, String,length);
if (indent && indent != 1) {
String_append(buf, '"');
while (len--) {
int c = *str++;
if (c >= ' ' && c <= '~') String_append(buf, c);
else if (c == '"') String_appendAll(buf, "\\\"");
else if (c == '\\') String_appendAll(buf, "\\\\");
else {
switch (c) {
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;
defalt: String_format(buf, "\\%03o", c); continue;
}
String_format(buf, "\\%c", c);
}
}
String_append(buf, '"');
return buf;
}
String_format(buf, "%.*s", len, str);
break;
}
case Symbol:
if (indent < 0) String_append(buf, '#');
String_appendAll(buf, _get(obj, Symbol,name));
break;
case Primitive: {
String_appendAll(buf, "<primitive ");
if (_get(obj, Primitive,name)) printOn(buf, _get(obj, Primitive,name), indent);
if (_get(obj, Primitive,name)) printOn(buf, _get(obj, Primitive,name), 0);
else String_format(buf, "%p", _get(obj, Primitive,function));
String_append(buf, '>');
break;
@ -869,65 +1064,40 @@ oop printOn(oop buf, oop obj, int indent)
#if PRIMCLOSURE
case Lambda: {
String_appendAll(buf, "<<Lambda>>");
if (!indent) break;
if (indent < 1) break;
String_append(buf, '\n');
for (int j = indent; j--;) String_appendAll(buf, " | ");
indentOn(buf, indent);
String_appendAll(buf, " body: ");
printOn(buf, _get(obj, Lambda,body), indent+1);
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);
printOn(buf, _get(obj, Lambda,parameters), indent + 1);
break;
}
case Closure: {
String_appendAll(buf, "<<Closure>>");
if (!indent) break;
if (indent < 1) 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);
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);
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, '>');
printObjectNameOn(buf, obj, indent);
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);
}
printObjectPropertiesOn(buf, obj, indent);
int isize = _get(obj, Object,isize);
oop *indexed = _get(obj, Object,indexed);
for (int i = 0; i < isize; ++i) {
@ -1170,18 +1340,18 @@ oop GetVar_eval(oop exp, oop env) { return getvar(env, Object_get(
void GetVar_codeOn(oop exp, oop str, oop env) { printOn(str, Object_get(exp, sym_name), 0); }
oop newSetVar(oop name, oop expr)
oop newSetVar(oop name, oop value)
{
oop o = new(pSetVar);
Object_put(o, sym_name, name);
Object_put(o, sym_expr, expr);
Object_put(o, sym_name, name);
Object_put(o, sym_value, value);
return o;
}
oop SetVar_eval(oop exp, oop env)
{
oop key = Object_get(exp, sym_name) ;
oop val = eval(Object_get(exp, sym_expr), env);
oop key = Object_get(exp, sym_name ) ;
oop val = eval(Object_get(exp, sym_value), env);
return setvar(env, key, val);
}
@ -1189,7 +1359,7 @@ void SetVar_codeOn(oop exp, oop str, oop env)
{
printOn(str, Object_get(exp, sym_name), 0);
String_appendAll(str, " = ");
codeOn(str, Object_get(exp, sym_expr), 0);
codeOn(str, Object_get(exp, sym_value), 0);
}
oop newRefProp(oop object, oop key)
@ -1618,6 +1788,7 @@ void Closure_codeOn(oop exp, oop str, oop env)
_(Add, +) _(Sub, -) \
_(Mul, *) _(Div, /) _(Mod, %) \
_(PostAdd, ++) _(PostDec, --) \
_(PreSet, =) \
_(PreOr, |=) _(PreXor, ^=) _(PreAnd, &=) \
_(PreShl, >>=) _(PreShr, <<=) \
_(PreAdd, +=) _(PreSub, -=) \
@ -1675,20 +1846,6 @@ binop(binBitAnd, &);
#undef binop
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));
return (intptr_t)l - (intptr_t)r;
}
#define newBoolean(TF) ((TF) ? sym_t : nil)
#define binop(NAME, OP) \
@ -1735,6 +1892,12 @@ oop binPostDec(oop lhs, oop rhs)
return value;
}
oop binPreSet(oop lhs, oop rhs)
{ assert(isInteger(lhs));
oop *ref = (oop *)(intptr_t)_integerValue(lhs); assert(isInteger(rhs));
return *ref = rhs;
}
#define binop(NAME, OP) \
oop NAME(oop lhs, oop rhs) \
{ assert(isInteger(lhs)); \
@ -1914,6 +2077,10 @@ oop Binop_eval(oop exp, oop env)
}
return value;
}
case opPreSet: { assert(isInteger(lhs)); // ref
oop *ref = (oop *)(intptr_t)_integerValue(lhs);
return *ref = rhs;
}
case opPreOr ... opPreMod: { assert(isInteger(lhs)); // ref
oop *ref = (oop *)(intptr_t)_integerValue(lhs);
oop val = *ref; assert(isInteger(rhs)); // delta
@ -2482,6 +2649,31 @@ void Literal_codeOn(oop exp, oop str, oop env)
# endif
}
oop lvalue(oop rval)
{
if (!is(Object,rval)) fatal("cannot assign to: %s", codeString(rval, 0));
oop kind = _getDelegate(rval);
if (kind == pGetVar ) kind = pRefVar;
else if (kind == pGetProp ) kind = pRefProp;
else if (kind == pGetArray) kind = pRefArray;
else fatal("cannot assign to: %s", codeString(rval, 0));
_setDelegate(rval, kind);
return rval;
}
oop assign(oop rval, oop value)
{
if (!is(Object,rval)) fatal("cannot assign to: %s", codeString(rval, 0));
oop kind = _getDelegate(rval);
if (kind == pGetVar ) kind = pSetVar;
else if (kind == pGetProp ) kind = pSetProp;
else if (kind == pGetArray) kind = pSetArray;
else fatal("cannot assign to: %s", codeString(rval, 0));
_setDelegate(rval, kind);
Object_put(rval, sym_value, value);
return rval;
}
%}
@ -2521,23 +2713,19 @@ proto = v:var ( DOT j:id !LPAREN { v = newGetProp(v, j) }
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
expr = i:id ASSIGN e:expr { $$ = newSetVar(i, e) }
| l:logor ( ASSIGN r:expr { l = assign(l, r) }
| PLUSEQ r:expr { l = newBinop(opPreAdd, lvalue(l), r) }
| MINUSEQ r:expr { l = newBinop(opPreSub, lvalue(l), r) }
| STAREQ r:expr { l = newBinop(opPreMul, lvalue(l), r) }
| SLASHEQ r:expr { l = newBinop(opPreDiv, lvalue(l), r) }
| PCENTEQ r:expr { l = newBinop(opPreMod, lvalue(l), r) }
| SHLEQ r:expr { l = newBinop(opPreShl, lvalue(l), r) }
| SHREQ r:expr { l = newBinop(opPreShr, lvalue(l), r) }
| ANDEQ r:expr { l = newBinop(opPreAnd, lvalue(l), r) }
| XOREQ r:expr { l = newBinop(opPreXor, lvalue(l), r) }
| OREQ r:expr { l = newBinop(opPreOr, lvalue(l), r) }
)? { $$ = l }
logor = l:logand ( BARBAR r:logand { l = newBinop(opLogOr, l, r) }
)* { $$ = l }
@ -2577,8 +2765,8 @@ prod = l:prefix ( STAR r:prefix { l = newBinop(opMul, 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)) }
prefix = PPLUS p:prefix { $$ = newBinop(opPreAdd, lvalue(p), newInteger(1)) }
| MMINUS p:prefix { $$ = newBinop(opPreSub, lvalue(p), newInteger(1)) }
| PLING p:prefix { $$ = newUnyop(opNot, p) }
| MINUS p:prefix { $$ = newUnyop(opNeg, p) }
| TILDE p:prefix { $$ = newUnyop(opCom, p) }
@ -2586,41 +2774,35 @@ prefix = PPLUS l:lvalue { $$ = newBinop(opPreAdd, l, new
| 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) }
postfix = p:primary
( LBRAK e:expr RBRAK { p = newGetArray(p, e) }
| DOT i:id ( a:args !LBRACE { p = newInvoke(p, i, a) }
| { p = newGetProp(p, i) }
)
| a:args !LBRACE { p = newApply(p, 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 }
( PPLUS { p = newBinop(opPostAdd, lvalue(p), newInteger( 1)) }
| MMINUS { p = newBinop(opPostAdd, lvalue(p), newInteger(-1)) }
)? { $$ = p }
args = LPAREN a:mkobj
( ( k:id COLON e:expr { Object_put(a, k, e) }
| e:expr { Object_push(a, e) }
( RPAREN
| ( 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 }
( 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 }
( RPAREN
| i:id ( COLON e:expr { Object_put(p, i, e) }
| { Object_push(p, i) }
)
( COMMA i:id ( COLON e:expr { Object_put(p, i, e) }
| { Object_push(p, i) }
)
)* RPAREN ) { $$ = p }
mkobj = { $$ = new(pObject) }
@ -2632,11 +2814,12 @@ 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) }
( RBRAK
| ( ( 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) }
@ -2644,9 +2827,9 @@ block = LBRACE b:mkobj
nil = NIL { $$ = nil }
number = "-" u:unsign { $$ = neg(u) }
| "+" n:number { $$ = u }
| u:unsign { $$ = u }
number = "-" n:unsign { $$ = neg(n) }
| "+" n:number { $$ = n }
| n:unsign { $$ = n }
unsign = < DIGIT+ '.' DIGIT* EXP? > - { $$ = newFloat(strtod(yytext, 0)) }
| < DIGIT* '.' DIGIT+ EXP? > - { $$ = newFloat(strtod(yytext, 0)) }
@ -2655,8 +2838,14 @@ unsign = < DIGIT+ '.' DIGIT* EXP? > - { $$ = newFloat(strtod(yytext, 0
| "0" < OIGIT* > - { $$ = newInteger(strtol(yytext, 0, 8)) }
| < DIGIT+ > - { $$ = newInteger(strtol(yytext, 0, 10)) }
string = '"' < ( !'"' . )* > '"' - { $$ = newStringEscaped(yytext) }
| "'" < ( !"'" . )* > "'" - { $$ = newStringEscaped(yytext) }
string = '"' < ( !'"' char )* > '"' - { $$ = newStringEscaped(yytext) }
| "'" < ( !"'" char )* > "'" - { $$ = newStringEscaped(yytext) }
char = "\\" ( ["'\\abfnrtv]
| [xX] HIGIT*
| [0-7][0-7]?[0-7]?
)
| .
symbol = HASH i:id { $$ = i }
@ -2794,8 +2983,15 @@ oop apply(oop func, oop self, oop args, oop env)
case NLR_RETURN: return nlrPop();
}
# endif
// positional args -> named parameters
for (int i = 0; i < nparam; ++i)
Object_put(args, pparam[i], i < nargs ? pargs[i] : nil);
// keyword defaults
int nkeywd = _get(parameters, Object,psize);
struct property *pkeywd = _get(parameters, Object,properties);
for (int i = 0; i < nkeywd; ++i)
if (Object_find(args, pkeywd[i].key) < 0)
Object_put(args, pkeywd[i].key, eval(pkeywd[i].val, args));
for (int i = 0; i < size; ++i)
result = eval(exprs[i], args);
# if NONLOCAL
@ -2930,57 +3126,23 @@ oop prim_length(oop func, oop self, oop args, oop env)
return newInteger(_get(self, Object,isize));
}
oop sortObject(oop obj, char *who)
oop prim_keys(oop func, oop self, oop args, oop env)
{
int limit = _get(obj, Object,isize);
oop *elts = _get(obj, Object,indexed);
for (int i = 0; i < limit - 1; ++i) {
int mindex = i;
oop minobj = elts[i];
for (int j = i + 1; j < limit; ++j) {
oop newobj = elts[j];
if (cmp(newobj, minobj, who) < 0) mindex = j, minobj = newobj;
}
if (mindex != i) {
oop tmpobj = elts[i];
elts[i] = minobj;
elts[mindex] = tmpobj;
}
}
return obj;
return keys(self, 0);
}
oop prim_keys(oop func, oop self, oop args, oop env)
oop prim_allKeys(oop func, oop self, oop args, oop env)
{
oop keys = new(pObject);
# if DELOPT
if (nil != _getDelegate(self)) Object_push(keys, prop_delegate);
# endif
switch (getType(self)) {
case Undefined: case Integer: case Float: case String: case Symbol: case Primitive:
break;
case Object: {
int size = _get(self, Object,psize);
struct property *kvs = _get(self, Object,properties);
for (int i = 0; i < size; ++i) Object_push(keys, kvs[i].key);
sortObject(keys, "keys");
break;
}
# if PRIMCLOSURE
case Lambda: {
Object_push(keys, sym_parameters);
Object_push(keys, sym_body);
break;
}
case Closure: {
Object_push(keys, sym_fixed);
Object_push(keys, sym_lambda);
Object_push(keys, sym_environment);
break;
}
# endif
return keys(self, 1);
}
oop prim_sorted(oop func, oop self, oop args, oop env)
{ assert(is(Object, args));
if (self == nil) {
if (_get(args, Object,isize) != 1) fatal("sorted: one argument expected");
self = _get(args, Object,indexed)[0];
}
return keys;
return sorted(self, "sorted");
}
oop prim_env(oop func, oop self, oop args, oop env)
@ -3007,8 +3169,8 @@ oop prim_print(oop func, oop self, oop args, oop env)
int argc = _get(args, Object,isize);
oop *indexed = _get(args, Object,indexed);
oop result = nil;
int indent = 0;
if (nil != Object_getLocal(args, sym_full)) indent = 1;
oop full = Object_getLocal(args, sym_full);
int indent = isInteger(full) ? _integerValue(full) : nil != full;
for (int i = 0; i < argc; ++i) print(result = indexed[i], indent);
fflush(stdout);
return nil;
@ -3137,7 +3299,7 @@ oop prim_exit(oop func, oop self, oop args, oop env)
oop replFile(FILE *in)
{
int oldline = lineno;
lineno = 0;
lineno = 1;
input = newInput();
readFile(in, &input->text, &input->size);
oop result = nil;
@ -3203,7 +3365,7 @@ 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__, newString("Object.__eval__"))); // inherited by all objects
#if TYPECODES
@ -3212,7 +3374,7 @@ int main(int argc, char **argv)
#else // !TYPECODES
# define defineEvaluator(NAME) \
Object_put(p##NAME, prop_eval, newPrimitive(prim_##NAME##_eval));
Object_put(p##NAME, prop_eval, newPrimitive(prim_##NAME##_eval, newString(#NAME".__eval__")));
#endif // !TYPECODES
@ -3221,7 +3383,7 @@ int main(int argc, char **argv)
# undef defineEvaluator
# define defineCodeOn(NAME) \
Object_put(p##NAME, prop_codeon, newPrimitive(prim_##NAME##_codeOn));
Object_put(p##NAME, prop_codeon, newPrimitive(prim_##NAME##_codeOn, newString(#NAME".codeOn")));
doProtos(defineCodeOn);
@ -3229,26 +3391,36 @@ int main(int argc, char **argv)
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("codeString" ), Symbol,value, newPrimitive(prim_codeString));
_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("readfile" ), Symbol,value, newPrimitive(prim_readfile));
_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("length"), newPrimitive(prim_length));
Object_put(pObject, intern("keys"), newPrimitive(prim_keys ));
# define prim(NAME, FUNC) _set(intern(#NAME), Symbol,value, newPrimitive(FUNC, newString(#NAME)))
prim(__env__ , prim_env);
prim(eval , prim_eval);
prim(print , prim_print);
prim(codeString , prim_codeString);
prim(sqrt , prim_sqrt);
prim(round , prim_round);
prim(truncate , prim_truncate);
prim(cputime , prim_cputime);
prim(evaluations, prim_evaluations);
prim(len , prim_len);
prim(ord , prim_ord);
prim(chr , prim_chr);
prim(readfile , prim_readfile);
prim(exit , prim_exit);
# undef prim
# define method(CLASS, NAME, FUNC) Object_put(p##CLASS, intern(#NAME), newPrimitive(FUNC, newString(#CLASS"."#NAME)))
method(Object,new, prim_new );
method(Object,push, prim_push );
method(Object,pop, prim_pop );
method(Object,length, prim_length );
method(Object,keys, prim_keys );
method(Object,allKeys, prim_allKeys);
method(Object,sorted, prim_sorted );
# undef method
_set(sym___globals__, Symbol,value, nil);

Пиши Преглед
Зареждане…
Отказ
Запис