@ -1,6 +1,6 @@
# minproto.leg -- minimal prototype langauge for semantic experiments
# minproto.leg -- minimal prototype langauge for semantic experiments
#
#
# last edited: 2024-05-09 13:59:36 by piumarta on zora-1034.local
# last edited: 2024-05-10 03:08:44 by piumarta on zora-1034.local
%{
%{
;
;
@ -98,6 +98,7 @@ doProtos(declareProto);
#define declareTypecode(NAME) t##NAME,
#define declareTypecode(NAME) t##NAME,
enum typecode {
enum typecode {
UNDEFINED_TYPECODE,
doProtos(declareTypecode)
doProtos(declareTypecode)
};
};
#undef declareTypecode
#undef declareTypecode
@ -396,6 +397,9 @@ oop newSymbol(char *name)
oop obj = make(Symbol);
oop obj = make(Symbol);
_set(obj, Symbol,name, strdup(name));
_set(obj, Symbol,name, strdup(name));
_set(obj, Symbol,value, UNDEFINED);
_set(obj, Symbol,value, UNDEFINED);
# if TYPECODES
_set(obj, Symbol,typecode, UNDEFINED_TYPECODE);
# endif
return obj;
return obj;
}
}
@ -559,6 +563,7 @@ oop Object_get(oop obj, oop key)
ssize_t ind = Object_find(obj, key);
ssize_t ind = Object_find(obj, key);
if (ind >= 0) return _get(obj, Object,properties)[ind].val;
if (ind >= 0) return _get(obj, Object,properties)[ind].val;
o = _getDelegate(obj);
o = _getDelegate(obj);
if (nil == o) o = pObject;
break;
break;
}
}
}
}
@ -580,7 +585,7 @@ oop getvar(oop obj, oop key)
obj = _getDelegate(obj);
obj = _getDelegate(obj);
}
}
oop value = _get(key, Symbol,value); // asserts is(Symbol,key)
oop value = _get(key, Symbol,value); // asserts is(Symbol,key)
if (! value) fatal("undefined variable: %s", storeString(key, 0));
if (UNDEFINED == value) fatal("undefined variable: %s", storeString(key, 0));
return value;
return value;
}
}
@ -1859,9 +1864,11 @@ oop Literal_eval(oop exp, oop env)
int psize = _get(object, Object,psize);
int psize = _get(object, Object,psize);
for (int i = 0; i < psize; ++i)
for (int i = 0; i < psize; ++i)
Object_put(clone, kvs[i].key, eval(kvs[i].val, env));
Object_put(clone, kvs[i].key, eval(kvs[i].val, env));
# if 0
oop delegate = _getDelegate(object);
oop delegate = _getDelegate(object);
if (nil != delegate)
if (nil != delegate)
Object_put(clone, prop_delegate, eval(delegate, env));
Object_put(clone, prop_delegate, eval(delegate, env));
# endif
return clone;
return clone;
}
}
@ -2187,9 +2194,8 @@ oop getArgType(oop args, int index, int type, char *who)
enum typecode getTypecode(oop exp)
enum typecode getTypecode(oop exp)
{
{
oop delegate = _getDelegate(exp);
oop delegate = _getDelegate(exp);
oop name = Object_get(delegate, prop_name);
enum typecode type = _get(name, Symbol,typecode);
return type;
oop name = Object_getLocal(delegate, prop_name);
return is(Symbol, name) ? _get(name, Symbol,typecode) : UNDEFINED_TYPECODE;
}
}
#else // !TYPECODES
#else // !TYPECODES
@ -2217,25 +2223,18 @@ doProtos(defineCodeOn)
static inline oop evalobj(oop exp, oop env)
static inline oop evalobj(oop exp, oop env)
{
{
# if !TYPECODES
oop delegate = _getDelegate(exp);
oop evaluator = Object_get(delegate, prop_eval);
return apply(evaluator, exp, new(pObject), env);
# else // TYPECODES
enum typecode type = getTypecode(exp);
# define defineEval(NAME) case t##NAME: return NAME##_eval(exp, env);
switch (type) {
# if TYPECODES
switch (getTypecode(exp)) {
case UNDEFINED_TYPECODE:
break;
# define defineEval(NAME) case t##NAME: return NAME##_eval(exp, env);
doProtos(defineEval);
doProtos(defineEval);
# undef defineEval
}
}
# undef defineEval
return exp;
# endif // TYPECODES
# endif // TYPECODES
oop evaluator = Object_get(exp, prop_eval);
return apply(evaluator, exp, new(pObject), env);
}
}
long evaluations = 0;
long evaluations = 0;
@ -2349,6 +2348,11 @@ oop prim_eval(oop func, oop self, oop args, oop env)
return result;
return result;
}
}
oop prim___eval__(oop func, oop self, oop args, oop env)
{
return self;
}
oop prim_print(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);
@ -2530,19 +2534,19 @@ int main(int argc, char **argv)
pObject = nil;
pObject = nil;
# define defineProto(NAME) \
p##NAME = new(pObject); \
Object_put(p##NAME, prop_name, intern(#NAME)); \
_set(intern(#NAME), Symbol,value, p##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);
doProtos(defineProto);
doTypes(defineProto);
doTypes(defineProto);
# undef defineProto
# undef defineProto
#if TYPECODES
Object_put(pObject, prop_eval, newPrimitive(prim___eval__)); // inherited by all objects
Object_put(pObject, prop_eval, newPrimitive(prim_env)); // inherited by all objects
#if TYPECODES
# define defineEvaluator(NAME) \
# define defineEvaluator(NAME) \
_set(intern(#NAME), Symbol,typecode, t##NAME);
_set(intern(#NAME), Symbol,typecode, t##NAME);