diff --git a/minproto.leg b/minproto.leg index dfb8c89..ae021f0 100644 --- a/minproto.leg +++ b/minproto.leg @@ -1,6 +1,6 @@ # minproto.leg -- minimal prototype langauge for semantic experiments # -# last edited: 2024-05-21 08:45:20 by piumarta on zora +# last edited: 2024-05-23 15:37:35 by piumarta on zora-1034.local %{ ; @@ -178,7 +178,7 @@ struct Symbol { enum type type; char *name; oop value; enum typecode typec #else // !TYPECODES struct Symbol { enum type type; char *name; oop value; }; #endif -struct Primitive { enum type type; oop name; prim_t function; }; +struct Primitive { enum type type; oop name; prim_t function; int index; }; #if PRIMCLOSURE struct Lambda { enum type type; oop parameters, body; }; struct Closure { enum type type; oop fixed, function, environment; }; @@ -372,6 +372,7 @@ oop String_append(oop str, int c) oop String_appendAllLen(oop str, char *s, int len) { + if (len < 1) return str; int length = get(str, String,length); char *value = get(str, String,value); value = xrealloc(value, length + len); @@ -386,6 +387,11 @@ oop String_appendAll(oop str, char *s) return String_appendAllLen(str, s, strlen(s)); } +oop String_appendString(oop str, oop val) +{ + return String_appendAllLen(str, _get(val, String,value), _get(val, String,length)); +} + oop String_format(oop str, char *fmt, ...) { size_t len = 0, cap = 16; @@ -419,7 +425,7 @@ oop String_concat(oop a, oop b) return result; } -oop newStringEscaped(char *string) +oop newStringUnescaped(char *string) { oop buf = newStringLen(0, 0); while (*string) { @@ -448,6 +454,47 @@ oop newStringEscaped(char *string) return buf; } +oop String_escaped(oop obj) +{ assert(is(String, obj)); + oop buf = newStringLen(0, 0); + char *str = _get(obj, String,value); + int len = _get(obj, String,length); + while (len--) { + int c = *str++; + if (c == '"') String_appendAll(buf, "\\\""); + else if (c == '\\') String_appendAll(buf, "\\\\"); + else if (c >= ' ' && c <= '~') String_append(buf, c); + 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; + default: + String_format(buf, "\\%03o", c); + continue; + } + String_format(buf, "\\%c", c); + } + } + + return buf; +} + +char *codeString(oop obj, int indent); + +oop String_push(oop obj, oop val) // val is String OR Integer +{ + if (isInteger(val)) String_append(obj, _integerValue(val)); + else if (is(String, val)) String_appendAllLen(obj, _get(val, String,value), _get(val, String,length)); + else if (is(Symbol, val)) String_appendAllLen(obj, _get(val, Symbol,name), strlen(_get(val, Symbol,name))); + else fatal("String.push: value is not integer, string, or symbol: %s", codeString(val, 0)); + return val; +} + oop newSymbol(char *name) { oop obj = make(Symbol); @@ -477,11 +524,19 @@ int stringLength(oop obj, char *who) return 0; } +oop Object_put(oop obj, oop key, oop val); +oop Object_push(oop obj, oop val); + +oop primitives = 0; + oop newPrimitive(prim_t function, oop name) { oop obj = make(Primitive); _set(obj, Primitive,name, name); _set(obj, Primitive,function, function); + _set(obj, Primitive,index, _get(primitives, Object,isize)); + Object_put(primitives, obj, newInteger(_get(primitives, Object,isize))); + Object_push(primitives, obj); return obj; } @@ -922,6 +977,43 @@ oop sorted(oop obj, char *who) return 0; } +oop reverseString(oop obj, char *who) +{ assert(is(String, obj)); + char *elts = _get(obj, String,value); + int size = _get(obj, String,length), middle = size / 2; + int left = 0, right = size; + while (left <= middle) { + int tmp = elts[left]; + elts[left++] = elts[--right]; + elts[right] = tmp; + } + return obj; +} + +oop reverseObject(oop obj, char *who) +{ assert(is(Object, obj)); + oop *elts = _get(obj, Object,indexed); + int size = _get(obj, Object,isize), middle = size / 2; + int left = 0, right = size; + while (left <= middle) { + oop tmp = elts[left]; + elts[left++] = elts[--right]; + elts[right] = tmp; + } + return obj; +} + +oop reversed(oop obj, char *who) +{ + switch (getType(obj)) { + case String: return reverseString(clone(obj), who); + case Object: return reverseObject(clone(obj), who); + default: break; + } + fatal("sort: cannot reverse %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) @@ -1049,25 +1141,7 @@ oop printOn(oop buf, oop obj, int indent) 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_appendString(buf, String_escaped(obj)); String_append(buf, '"'); return buf; } @@ -1114,7 +1188,6 @@ oop printOn(oop buf, oop obj, int indent) String_appendAll(buf, " function: "); printOn(buf, _get(obj, Closure,function), indent + 1); break; - break; } #endif case Object: { @@ -2336,7 +2409,7 @@ void Let_codeOn(oop exp, oop str, oop env) String_appendAll(str, "let "); for (int i = 0; i < isize - 1; i += 2) { if (i) String_appendAll(str, ", "); - codeOn(str, indexed[i], 0); + printOn(str, indexed[i], 0); String_appendAll(str, " = "); codeOn(str, indexed[i+1], 0); } @@ -2624,6 +2697,7 @@ oop newLiteral(oop object) oop Literal_eval(oop exp, oop env) { oop object = Object_get(exp, sym_object); +// if (is(String, object)) return newStringLen(_get(object, String,value), _get(object, String,length)); oop clone = new(pObject); oop *indexed = _get(object, Object,indexed); int isize = _get(object, Object,isize); @@ -2633,11 +2707,6 @@ oop Literal_eval(oop exp, oop 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)); -# endif return clone; } @@ -2712,7 +2781,6 @@ oop assign(oop rval, oop value) %} - start = - ( s:stmt { yysval = s } | !. { yysval = 0 } | < (!EOL .)* > { fatal("syntax error near: %s", yytext) } @@ -2875,9 +2943,9 @@ unsign = < DIGIT+ '.' DIGIT* EXP? > - { $$ = newFloat(strtod(yytext, 0 | "0" [xX] < HIGIT+ > - { $$ = newInteger(strtol(yytext, 0, 16)) } | "0" < OIGIT* > - { $$ = newInteger(strtol(yytext, 0, 8)) } | < DIGIT+ > - { $$ = newInteger(strtol(yytext, 0, 10)) } + | "'" < char > "'" - { $$ = newInteger(_get(newStringUnescaped(yytext), String,value)[0]) } -string = '"' < ( !'"' char )* > '"' - { $$ = newStringEscaped(yytext) } - | "'" < ( !"'" char )* > "'" - { $$ = newStringEscaped(yytext) } +string = '"' < ( !'"' char )* > '"' - { $$ = newStringUnescaped(yytext) } char = "\\" ( ["'\\abfnrtv] | [xX] HIGIT* @@ -2902,8 +2970,10 @@ EXP = [eE] SIGN DIGIT+ - = SPACE* -SPACE = [ \t] | EOL | '//' (!EOL .)* +SPACE = [ \t] | EOL | SLC | MLC EOL = [\n\r] { ++lineno } +SLC = "//" (!EOL .)* +MLC = "/*" ( MLC | !"*/" (EOL | .))* "*/" - NIL = "nil" !ALNUM - WHILE = "while" !ALNUM - @@ -3108,7 +3178,13 @@ oop eval(oop exp, oop env) if (Lambda == type) return newClosure(exp, env); # endif if (Object != type) return exp; - if (!opt_O) Object_push(trace, exp); + if (!opt_O) { + Object_push(trace, exp); + if (opt_d && opt_v) { + printf("@@@ "); + codeln(exp, 0); + } + } oop result = evalobj(exp, env); if (!opt_O) Object_pop(trace); return result; @@ -3138,18 +3214,16 @@ oop prim_new(oop func, oop self, oop args, oop env) return args; } -oop prim_push(oop func, oop self, oop args, oop env) +oop prim_Object_push(oop func, oop self, oop args, oop env) { assert(is(Object, args)); - if (!is(Object, self)) fatal("push: not an object"); - int argc = _get(args, Object,isize); + int argc = _get(args, Object,isize); assert(is(Object, self)); oop *indexed = _get(args, Object,indexed); 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)); - if (!is(Object, self)) fatal("pop: not an object"); +oop prim_Object_pop(oop func, oop self, oop args, oop env) +{ assert(is(Object, self)); int size = _get(self, Object,isize); if (size < 1) fatal("pop: object is empty\n"); --size; @@ -3157,6 +3231,145 @@ oop prim_pop(oop func, oop self, oop args, oop env) return _get(self, Object,indexed)[size]; } +oop prim_String_new(oop func, oop self, oop args, oop env) +{ + return newStringLen(0, 0); +} + +oop prim_String_escaped(oop func, oop self, oop args, oop env) +{ + return String_escaped(self); +} + +oop prim_String_unescaped(oop func, oop self, oop args, oop env) +{ + return newStringUnescaped(String_content(self)); +} + +oop prim_String_push(oop func, oop self, oop args, oop env) +{ assert(is(Object, args)); + int argc = _get(args, Object,isize); assert(is(String, self)); + oop *indexed = _get(args, Object,indexed); + for (int i = 0; i < argc; ++i) String_push(self, indexed[i]); + return self; +} + +oop prim_String_pop(oop func, oop self, oop args, oop env) +{ assert(is(String, self)); + int size = _get(self, String,length); + if (size < 1) fatal("pop: string is empty\n"); + --size; + _set(self, String,length, size); + return newInteger(_get(self, String,value)[size]); +} + +oop prim_String_asInteger(oop func, oop self, oop args, oop env) +{ assert(is(String, self)); + char *str = String_content(self); // ensure nul terminator + char *end = 0; + long value = strtol(str, &end, 0); + if (*end) return nil; + return newInteger(value); +} + +oop prim_String_asFloat(oop func, oop self, oop args, oop env) +{ assert(is(String, self)); + char *str = String_content(self); // ensure nul terminator + char *end = 0; + double value = strtod(str, &end); + if (*end) return nil; + return newFloat(value); +} + +oop prim_String_asSymbol(oop func, oop self, oop args, oop env) +{ assert(is(String, self)); + return intern(String_content(self)); +} + +char *strnchr(char *s, int len, int c) +{ + while (len--) if (c == *s++) return s-1; + return 0; +} + +#if !defined(__MACH__) // BSD has this in libc + +char *strnstr(char *s, char *t, int slen) +{ + int tlen = strlen(t); + int limit = slen - tlen; + for (int i = 0; i <= limit; ++i) + if (!strncmp(s + i, t, tlen)) + return s+i; + return 0; +} + +#endif + +oop prim_Object_includes(oop func, oop self, oop args, oop env) +{ assert(is(Object, args)); + if (!is(Object, self)) return nil; + int argc = _get(args, Object,isize); + oop *argv = _get(args, Object,indexed); + int size = _get(self, Object,isize); + oop *elts = _get(self, Object,indexed); + for (int i = 0; i < argc; ++i) { + oop arg = argv[i]; + int found = 0; + for (int j = 0; j < size; ++j) + if ((found = (elts[j] == arg))) + break; + if (!found) return nil; + } + return sym_t; +} + +oop prim_String_includes(oop func, oop self, oop args, oop env) +{ assert(is(Object, args)); + int size = _get(args, Object,isize); assert(is(String, self)); + oop *elts = _get(args, Object,indexed); + char *value = _get(self, String,value); + int length = _get(self, String,length); + for (int i = 0; i < size; ++i) { + oop arg = elts[i]; + switch (getType(arg)) { + case Integer: + if (!strnchr(value, length, _integerValue(arg))) return nil; + continue; + case String: + if (!strnstr(value, String_content(arg), length)) return nil; + continue; + default: + fatal("String.includes: argument not string or integer: %s", codeString(arg, 0)); + break; + } + } + return sym_t; +} + +oop prim_String_sliced(oop func, oop self, oop args, oop env) +{ assert(is(Object, args)); + int argc = _get(args, Object,isize); assert(is(String, self)); + if (argc != 2) fatal("String.sliced: two arguments expected"); + oop *argv = _get(args, Object,indexed); + char *value = _get(self, String,value); + int length = _get(self, String,length); + int start = integerValue(argv[0], "String.sliced"); + int end = integerValue(argv[1], "String.sliced"); + if (start < 0) start += length; + if (start < 0 || start >= length) fatal("String.sliced: start index %d out of bounds", start); + if (end < 0) end += length; + if (end < 0 || end >= length) fatal("String.sliced: end index %d out of bounds", end); + oop result = newStringLen(0, 0); + String_appendAllLen(result, value + start, end - start + 1); + return result; +} + +oop prim_Symbol_asString(oop func, oop self, oop args, oop env) +{ assert(is(Symbol, self)); + return newString(_get(self, Symbol,name)); +} + oop prim_length(oop func, oop self, oop args, oop env) { assert(is(Object, args)); if (!is(Object, self)) fatal("length: not an object"); @@ -3173,6 +3386,17 @@ oop prim_allKeys(oop func, oop self, oop args, oop env) return keys(self, 1); } +oop prim_findKey(oop func, oop self, oop args, oop env) +{ + if (is(Object, self)) { + if (_get(args, Object,isize) != 1) fatal("Object.findKey: one argument expected"); + oop key = _get(args, Object,indexed)[0]; + int index = Object_find(self, key); + return newInteger(index); + } + return nil; +} + oop prim_sorted(oop func, oop self, oop args, oop env) { assert(is(Object, args)); if (self == nil) { @@ -3182,6 +3406,15 @@ oop prim_sorted(oop func, oop self, oop args, oop env) return sorted(self, "sorted"); } +oop prim_reversed(oop func, oop self, oop args, oop env) +{ assert(is(Object, args)); + if (self == nil) { + if (_get(args, Object,isize) != 1) fatal("reversed: one argument expected"); + self = _get(args, Object,indexed)[0]; + } + return reversed(self, "reversed"); +} + oop prim_env(oop func, oop self, oop args, oop env) { return env; @@ -3357,9 +3590,46 @@ oop prim_Symbol_setopt(oop func, oop self, oop args, oop env) return val; } +oop prim_Symbol_getopt(oop func, oop self, oop args, oop env) +{ assert(is(Symbol, self)); + if (sym_O == self) return newInteger(opt_O); + else if (sym_d == self) return newInteger(opt_d); + else if (sym_v == self) return newInteger(opt_v); + else fatal("getopt: unknown option: %s", storeString(self, 0)); + return 0; +} + +oop prim_defined(oop func, oop self, oop args, oop env) +{ assert(is(Object, args)); + if (1 != _get(args, Object,isize)) fatal("defined: one argument expected"); + oop arg = _get(args, Object,indexed)[0]; + return UNDEFINED == *_refvar(env, arg) ? nil : sym_t; // looks in locals too +} + oop prim_Symbol_defined(oop func, oop self, oop args, oop env) +{ assert(is(Symbol, self)); + return UNDEFINED == _get(self, Symbol,value) ? nil : sym_t; // looks only at global +} + +oop prim_Symbol_define(oop func, oop self, oop args, oop env) +{ assert(is(Object, args)); + int argc = _get(args, Object,isize); assert(is(Symbol, self)); + if (argc != 1) fatal("Symbol.define: one argument expected"); + _set(self, Symbol,value, _get(args, Object,indexed)[0]); + return self; +} + +oop prim_Symbol_value(oop func, oop self, oop args, oop env) +{ assert(is(Symbol, self)); + oop value = _get(self, Symbol,value); + return value ? value : nil; +} + +oop prim_Symbol_allInstances(oop func, oop self, oop args, oop env) { - return *_refvar(env, self) ? sym_t : nil; + oop result = new(pObject); + for (int i = 0; i < nsymbols; ++i) Object_push(result, symbols[i]); + return result; } oop replFile(FILE *in) @@ -3407,6 +3677,8 @@ oop replPath(char *path) return result; } + + int main(int argc, char **argv) { GC_INIT(); @@ -3431,6 +3703,10 @@ int main(int argc, char **argv) # undef defineProto + primitives = new(pObject); + + _set(intern("__primitives__"), Symbol,value, primitives); + Object_put(pObject, prop_eval, newPrimitive(prim___eval__, newString("Object.__eval__"))); // inherited by all objects #if TYPECODES @@ -3475,20 +3751,39 @@ int main(int argc, char **argv) prim(readfile , prim_readfile); prim(exit , prim_exit); prim(fatal , prim_error); + prim(defined , prim_defined); # 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 ); - method(Symbol,defined, prim_Symbol_defined); - method(Symbol,setopt, prim_Symbol_setopt); + method(Object,new, prim_new ); + method(Object,push, prim_Object_push ); + method(Object,pop, prim_Object_pop ); + method(Object,length, prim_length ); + method(Object,keys, prim_keys ); + method(Object,allKeys, prim_allKeys ); + method(Object,findKey, prim_findKey ); + method(Object,sorted, prim_sorted ); + method(Object,reversed, prim_reversed ); + method(Object,includes, prim_Object_includes ); + method(String,new, prim_String_new ); + method(String,escaped, prim_String_escaped ); + method(String,unescaped, prim_String_unescaped); + method(String,push, prim_String_push ); + method(String,pop, prim_String_pop ); + method(String,asInteger, prim_String_asInteger); + method(String,asFloat, prim_String_asFloat ); + method(String,asSymbol, prim_String_asSymbol ); + method(String,includes, prim_String_includes ); + method(String,sliced, prim_String_sliced ); + method(Symbol,asString, prim_Symbol_asString ); + method(Symbol,setopt, prim_Symbol_setopt ); + method(Symbol,getopt, prim_Symbol_getopt ); + method(Symbol,defined, prim_Symbol_defined ); + method(Symbol,define, prim_Symbol_define ); + method(Symbol,value, prim_Symbol_value ); + method(Symbol,allInstances, prim_Symbol_allInstances); # undef method