* Implemented multi-argument primops.
This commit is contained in:
parent
45d822f29c
commit
3d2b835f30
1 changed files with 36 additions and 9 deletions
|
@ -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;
|
||||||
|
|
Loading…
Reference in a new issue