* Primops (not yet finished).
This commit is contained in:
Eelco Dolstra
parent
cad8726b2c
commit
45d822f29c
1 changed files with 114 additions and 16 deletions
|
|
@ -32,10 +32,15 @@ typedef enum {
|
|||
tThunk,
|
||||
tLambda,
|
||||
tCopy,
|
||||
tBlackhole
|
||||
tBlackhole,
|
||||
tPrimOp,
|
||||
tPrimOpApp,
|
||||
} ValueType;
|
||||
|
||||
|
||||
typedef void (* PrimOp_) (Value * * args, Value & v);
|
||||
|
||||
|
||||
struct Value
|
||||
{
|
||||
ValueType type;
|
||||
|
|
@ -58,6 +63,14 @@ struct Value
|
|||
Expr body;
|
||||
} lambda;
|
||||
Value * val;
|
||||
struct {
|
||||
PrimOp_ fun;
|
||||
unsigned int arity;
|
||||
} primOp;
|
||||
struct {
|
||||
Value * left, * right;
|
||||
unsigned int argsLeft;
|
||||
} primOpApp;
|
||||
};
|
||||
};
|
||||
|
||||
|
|
@ -89,6 +102,12 @@ std::ostream & operator << (std::ostream & str, Value & v)
|
|||
case tLambda:
|
||||
str << "<LAMBDA>";
|
||||
break;
|
||||
case tPrimOp:
|
||||
str << "<PRIMOP>";
|
||||
break;
|
||||
case tPrimOpApp:
|
||||
str << "<PRIMOP-APP>";
|
||||
break;
|
||||
default:
|
||||
abort();
|
||||
}
|
||||
|
|
@ -96,14 +115,14 @@ std::ostream & operator << (std::ostream & str, Value & v)
|
|||
}
|
||||
|
||||
|
||||
static void eval(Env * env, Expr e, Value & v);
|
||||
static void eval(Env & env, Expr e, Value & v);
|
||||
|
||||
|
||||
static void forceValue(Value & v)
|
||||
{
|
||||
if (v.type == tThunk) {
|
||||
v.type = tBlackhole;
|
||||
eval(v.thunk.env, v.thunk.expr, v);
|
||||
eval(*v.thunk.env, v.thunk.expr, v);
|
||||
}
|
||||
else if (v.type == tCopy) {
|
||||
forceValue(*v.val);
|
||||
|
|
@ -208,7 +227,7 @@ static Env * allocEnv()
|
|||
char * p1 = 0, * p2 = 0;
|
||||
|
||||
|
||||
static void eval(Env * env, Expr e, Value & v)
|
||||
static void eval(Env & env, Expr e, Value & v)
|
||||
{
|
||||
char c;
|
||||
if (!p1) p1 = &c; else if (!p2) p2 = &c;
|
||||
|
|
@ -217,7 +236,7 @@ static void eval(Env * env, Expr e, Value & v)
|
|||
|
||||
Sym name;
|
||||
if (matchVar(e, name)) {
|
||||
Value * v2 = lookupVar(env, name);
|
||||
Value * v2 = lookupVar(&env, name);
|
||||
forceValue(*v2);
|
||||
v = *v2;
|
||||
return;
|
||||
|
|
@ -240,7 +259,7 @@ static void eval(Env * env, Expr e, Value & v)
|
|||
Value & v2 = (*v.attrs)[name];
|
||||
nrValues++;
|
||||
v2.type = tThunk;
|
||||
v2.thunk.env = env;
|
||||
v2.thunk.env = &env;
|
||||
v2.thunk.expr = e2;
|
||||
}
|
||||
return;
|
||||
|
|
@ -249,7 +268,7 @@ static void eval(Env * env, Expr e, Value & v)
|
|||
ATermList rbnds, nrbnds;
|
||||
if (matchRec(e, rbnds, nrbnds)) {
|
||||
Env * env2 = allocEnv();
|
||||
env2->up = env;
|
||||
env2->up = &env;
|
||||
|
||||
v.type = tAttrs;
|
||||
v.attrs = &env2->bindings;
|
||||
|
|
@ -280,7 +299,7 @@ static void eval(Env * env, Expr e, Value & v)
|
|||
Pattern pat; Expr body; Pos pos;
|
||||
if (matchFunction(e, pat, body, pos)) {
|
||||
v.type = tLambda;
|
||||
v.lambda.env = env;
|
||||
v.lambda.env = &env;
|
||||
v.lambda.pat = pat;
|
||||
v.lambda.body = body;
|
||||
return;
|
||||
|
|
@ -289,17 +308,47 @@ static void eval(Env * env, Expr e, Value & v)
|
|||
Expr fun, arg;
|
||||
if (matchCall(e, fun, arg)) {
|
||||
eval(env, fun, v);
|
||||
|
||||
if (v.type == tPrimOp || v.type == tPrimOpApp) {
|
||||
if ((v.type == tPrimOp && v.primOp.arity == 1) ||
|
||||
(v.type == tPrimOpApp && v.primOpApp.argsLeft == 1))
|
||||
{
|
||||
/* We have all the arguments, so call the primop.
|
||||
First find the primop. */
|
||||
Value * primOp = &v;
|
||||
while (primOp->type == tPrimOpApp) primOp = primOp->primOpApp.left;
|
||||
assert(primOp->type == tPrimOp);
|
||||
unsigned int arity = primOp->primOp.arity;
|
||||
|
||||
Value vLastArg;
|
||||
vLastArg.type = tThunk;
|
||||
vLastArg.thunk.env = &env;
|
||||
vLastArg.thunk.expr = arg;
|
||||
|
||||
Value * vArgs[arity];
|
||||
unsigned int n = arity - 1;
|
||||
vArgs[n--] = &vLastArg;
|
||||
for (Value * arg = &v; arg->type == tPrimOpApp; arg = arg->primOpApp.left)
|
||||
vArgs[n--] = arg->primOpApp.right;
|
||||
|
||||
primOp->primOp.fun(vArgs, v);
|
||||
} else {
|
||||
throw Error("bar");
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
if (v.type != tLambda) throw TypeError("expected function");
|
||||
|
||||
Env * env2 = allocEnv();
|
||||
env2->up = env;
|
||||
env2->up = &env;
|
||||
|
||||
ATermList formals; ATerm ellipsis;
|
||||
|
||||
if (matchVarPat(v.lambda.pat, name)) {
|
||||
Value & vArg = env2->bindings[name];
|
||||
vArg.type = tThunk;
|
||||
vArg.thunk.env = env;
|
||||
vArg.thunk.env = &env;
|
||||
vArg.thunk.expr = arg;
|
||||
}
|
||||
|
||||
|
|
@ -352,20 +401,20 @@ static void eval(Env * env, Expr e, Value & v)
|
|||
|
||||
else abort();
|
||||
|
||||
eval(env2, v.lambda.body, v);
|
||||
eval(*env2, v.lambda.body, v);
|
||||
return;
|
||||
}
|
||||
|
||||
Expr attrs;
|
||||
if (matchWith(e, attrs, body, pos)) {
|
||||
Env * env2 = allocEnv();
|
||||
env2->up = env;
|
||||
env2->up = &env;
|
||||
|
||||
Value & vAttrs = env2->bindings[sWith];
|
||||
eval(env, attrs, vAttrs);
|
||||
if (vAttrs.type != tAttrs) throw TypeError("`with' should evaluate to an attribute set");
|
||||
|
||||
eval(env2, body, v);
|
||||
eval(*env2, body, v);
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -375,7 +424,7 @@ static void eval(Env * env, Expr e, Value & v)
|
|||
v.list.elems = new Value[v.list.length]; // !!! check destructor
|
||||
for (unsigned int n = 0; n < v.list.length; ++n, es = ATgetNext(es)) {
|
||||
v.list.elems[n].type = tThunk;
|
||||
v.list.elems[n].thunk.env = env;
|
||||
v.list.elems[n].thunk.env = &env;
|
||||
v.list.elems[n].thunk.expr = ATgetFirst(es);
|
||||
}
|
||||
return;
|
||||
|
|
@ -416,7 +465,7 @@ static void eval(Env * env, Expr e, Value & v)
|
|||
}
|
||||
|
||||
|
||||
static void strictEval(Env * env, Expr e, Value & v)
|
||||
static void strictEval(Env & env, Expr e, Value & v)
|
||||
{
|
||||
eval(env, e, v);
|
||||
|
||||
|
|
@ -432,14 +481,59 @@ static void strictEval(Env * env, Expr e, Value & v)
|
|||
}
|
||||
|
||||
|
||||
static void prim_head(Value * * args, Value & v)
|
||||
{
|
||||
forceValue(*args[0]);
|
||||
if (args[0]->type != tList) throw TypeError("list expected");
|
||||
if (args[0]->list.length == 0)
|
||||
throw Error("`head' called on an empty list");
|
||||
forceValue(args[0]->list.elems[0]);
|
||||
v = args[0]->list.elems[0];
|
||||
}
|
||||
|
||||
|
||||
static void prim_add(Value * * args, Value & v)
|
||||
{
|
||||
throw Error("foo");
|
||||
}
|
||||
|
||||
|
||||
static void addPrimOp(Env & env, const string & name, unsigned int arity, PrimOp_ fun)
|
||||
{
|
||||
Value & v = env.bindings[toATerm(name)];
|
||||
v.type = tPrimOp;
|
||||
v.primOp.arity = arity;
|
||||
v.primOp.fun = fun;
|
||||
}
|
||||
|
||||
|
||||
void doTest(string s)
|
||||
{
|
||||
Env baseEnv;
|
||||
baseEnv.up = 0;
|
||||
|
||||
/* Add global constants such as `true' to the base environment. */
|
||||
{
|
||||
Value & v = baseEnv.bindings[toATerm("true")];
|
||||
v.type = tBool;
|
||||
v.boolean = true;
|
||||
}
|
||||
{
|
||||
Value & v = baseEnv.bindings[toATerm("false")];
|
||||
v.type = tBool;
|
||||
v.boolean = false;
|
||||
}
|
||||
|
||||
/* Add primops to the base environment. */
|
||||
addPrimOp(baseEnv, "__head", 1, prim_head);
|
||||
addPrimOp(baseEnv, "__add", 2, prim_add);
|
||||
|
||||
p1 = p2 = 0;
|
||||
EvalState state;
|
||||
Expr e = parseExprFromString(state, s, "/");
|
||||
printMsg(lvlError, format(">>>>> %1%") % e);
|
||||
Value v;
|
||||
strictEval(0, e, v);
|
||||
strictEval(baseEnv, e, v);
|
||||
printMsg(lvlError, format("result: %1%") % v);
|
||||
}
|
||||
|
||||
|
|
@ -478,6 +572,10 @@ void run(Strings args)
|
|||
doTest("{ x = 1; y = 2; } == { x = 2; }");
|
||||
doTest("{ x = [ 1 2 ]; } == { x = [ 1 ] ++ [ 2 ]; }");
|
||||
doTest("1 != 1");
|
||||
doTest("true");
|
||||
doTest("true == false");
|
||||
doTest("__head [ 1 2 3 ]");
|
||||
doTest("__add 1 2");
|
||||
|
||||
printMsg(lvlError, format("alloced %1% values") % nrValues);
|
||||
printMsg(lvlError, format("alloced %1% environments") % nrEnvs);
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue