@ -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 newStringE scaped(char *string)
oop newStringUne scaped(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, ", ");
code On(str, indexed[i], 0);
print On(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