qyriad/lix
1
0
Fork 0
forked from lix-project/lix
Code Pull requests Activity

* Implemented multi-argument primops.

Browse source
This commit is contained in:
Eelco Dolstra 2010-03-28 16:37:39 +00:00
parent 45d822f29c
commit 3d2b835f30
1 changed files with 36 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

43
src/libexpr/eval-test.cc
View file

@ -217,6 +217,12 @@ static bool eqValues(Value & v1, Value & v2)
unsigned long nrValues = 0, nrEnvs = 0; unsigned long nrValues = 0, nrEnvs = 0;
static Value * allocValues(unsigned int count)
{
nrValues += count;
return new Value[count];// !!! check destructor
}
static Env * allocEnv() static Env * allocEnv()
{ {
nrEnvs++; nrEnvs++;
@ -310,9 +316,9 @@ static void eval(Env & env, Expr e, Value & v)
eval(env, fun, v); eval(env, fun, v);
if (v.type == tPrimOp || v.type == tPrimOpApp) { if (v.type == tPrimOp || v.type == tPrimOpApp) {
if ((v.type == tPrimOp && v.primOp.arity == 1) || unsigned int argsLeft =
(v.type == tPrimOpApp && v.primOpApp.argsLeft == 1)) v.type == tPrimOp ? v.primOp.arity : v.primOpApp.argsLeft;
{ if (argsLeft == 1) {
/* We have all the arguments, so call the primop. /* We have all the arguments, so call the primop.
First find the primop. */ First find the primop. */
Value * primOp = &v; Value * primOp = &v;
@ -325,15 +331,25 @@ static void eval(Env & env, Expr e, Value & v)
vLastArg.thunk.env = &env; vLastArg.thunk.env = &env;
vLastArg.thunk.expr = arg; vLastArg.thunk.expr = arg;
/* Put all the arguments in an array. */
Value * vArgs[arity]; Value * vArgs[arity];
unsigned int n = arity - 1; unsigned int n = arity - 1;
vArgs[n--] = &vLastArg; vArgs[n--] = &vLastArg;
for (Value * arg = &v; arg->type == tPrimOpApp; arg = arg->primOpApp.left) for (Value * arg = &v; arg->type == tPrimOpApp; arg = arg->primOpApp.left)
vArgs[n--] = arg->primOpApp.right; vArgs[n--] = arg->primOpApp.right;
/* And call the primop. */
primOp->primOp.fun(vArgs, v); primOp->primOp.fun(vArgs, v);
} else { } else {
throw Error("bar"); Value * v2 = allocValues(2);
v2[0] = v;
v2[1].type = tThunk;
v2[1].thunk.env = &env;
v2[1].thunk.expr = arg;
v.type = tPrimOpApp;
v.primOpApp.left = &v2[0];
v.primOpApp.right = &v2[1];
v.primOpApp.argsLeft = argsLeft - 1;
} }
return; return;
} }
@ -347,6 +363,7 @@ static void eval(Env & env, Expr e, Value & v)
if (matchVarPat(v.lambda.pat, name)) { if (matchVarPat(v.lambda.pat, name)) {
Value & vArg = env2->bindings[name]; Value & vArg = env2->bindings[name];
nrValues++;
vArg.type = tThunk; vArg.type = tThunk;
vArg.thunk.env = &env; vArg.thunk.env = &env;
vArg.thunk.expr = arg; vArg.thunk.expr = arg;
@ -358,8 +375,10 @@ static void eval(Env & env, Expr e, Value & v)
if (name == sNoAlias) if (name == sNoAlias)
vArg = &vArg_; vArg = &vArg_;
else else {
vArg = &env2->bindings[name]; vArg = &env2->bindings[name];
nrValues++;
}
eval(env, arg, *vArg); eval(env, arg, *vArg);
if (vArg->type != tAttrs) throw TypeError("expected attribute set"); if (vArg->type != tAttrs) throw TypeError("expected attribute set");
@ -376,6 +395,7 @@ static void eval(Env & env, Expr e, Value & v)
Bindings::iterator j = vArg->attrs->find(name); Bindings::iterator j = vArg->attrs->find(name);
Value & v = env2->bindings[name]; Value & v = env2->bindings[name];
nrValues++;
if (j == vArg->attrs->end()) { if (j == vArg->attrs->end()) {
if (!matchDefaultValue(def2, def)) def = 0; if (!matchDefaultValue(def2, def)) def = 0;
@ -411,6 +431,7 @@ static void eval(Env & env, Expr e, Value & v)
env2->up = &env; env2->up = &env;
Value & vAttrs = env2->bindings[sWith]; Value & vAttrs = env2->bindings[sWith];
nrValues++;
eval(env, attrs, vAttrs); eval(env, attrs, vAttrs);
if (vAttrs.type != tAttrs) throw TypeError("`with' should evaluate to an attribute set"); if (vAttrs.type != tAttrs) throw TypeError("`with' should evaluate to an attribute set");
@ -421,7 +442,7 @@ static void eval(Env & env, Expr e, Value & v)
if (matchList(e, es)) { if (matchList(e, es)) {
v.type = tList; v.type = tList;
v.list.length = ATgetLength(es); v.list.length = ATgetLength(es);
v.list.elems = new Value[v.list.length]; // !!! check destructor v.list.elems = allocValues(v.list.length);
for (unsigned int n = 0; n < v.list.length; ++n, es = ATgetNext(es)) { for (unsigned int n = 0; n < v.list.length; ++n, es = ATgetNext(es)) {
v.list.elems[n].type = tThunk; v.list.elems[n].type = tThunk;
v.list.elems[n].thunk.env = &env; v.list.elems[n].thunk.env = &env;
@ -451,7 +472,7 @@ static void eval(Env & env, Expr e, Value & v)
if (v2.type != tList) throw TypeError("list expected"); if (v2.type != tList) throw TypeError("list expected");
v.type = tList; v.type = tList;
v.list.length = v1.list.length + v2.list.length; v.list.length = v1.list.length + v2.list.length;
v.list.elems = new Value[v.list.length]; v.list.elems = allocValues(v.list.length);
/* !!! This loses sharing with the original lists. We could /* !!! This loses sharing with the original lists. We could
use a tCopy node, but that would use more memory. */ use a tCopy node, but that would use more memory. */
for (unsigned int n = 0; n < v1.list.length; ++n) for (unsigned int n = 0; n < v1.list.length; ++n)
@ -494,13 +515,19 @@ static void prim_head(Value * * args, Value & v)
static void prim_add(Value * * args, Value & v) static void prim_add(Value * * args, Value & v)
{ {
throw Error("foo"); forceValue(*args[0]);
if (args[0]->type != tInt) throw TypeError("integer expected");
forceValue(*args[1]);
if (args[1]->type != tInt) throw TypeError("integer expected");
v.type = tInt;
v.integer = args[0]->integer + args[1]->integer;
} }
static void addPrimOp(Env & env, const string & name, unsigned int arity, PrimOp_ fun) static void addPrimOp(Env & env, const string & name, unsigned int arity, PrimOp_ fun)
{ {
Value & v = env.bindings[toATerm(name)]; Value & v = env.bindings[toATerm(name)];
nrValues++;
v.type = tPrimOp; v.type = tPrimOp;
v.primOp.arity = arity; v.primOp.arity = arity;
v.primOp.fun = fun; v.primOp.fun = fun;