From 45d822f29c84644d1b795bd36999e97f30cfb8ba Mon Sep 17 00:00:00 2001 From: Eelco Dolstra Date: Fri, 26 Mar 2010 15:45:53 +0000 Subject: [PATCH] * Primops (not yet finished). --- src/libexpr/eval-test.cc | 130 ++++++++++++++++++++++++++++++++++----- 1 file changed, 114 insertions(+), 16 deletions(-) diff --git a/src/libexpr/eval-test.cc b/src/libexpr/eval-test.cc index 631d52a82..90e918e00 100644 --- a/src/libexpr/eval-test.cc +++ b/src/libexpr/eval-test.cc @@ -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 << ""; break; + case tPrimOp: + str << ""; + break; + case tPrimOpApp: + str << ""; + 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);