forked from lix-project/lix
* Lambdas, applications, substitutions.
This commit is contained in:
parent
bc57eb3c8a
commit
94cf1f86bb
63
src/eval.cc
63
src/eval.cc
|
@ -247,25 +247,72 @@ void evalArgs(ATermList args, ATermList & argsNF, Environment & env)
|
|||
env[name] = queryValuePath(parseHash(s));
|
||||
} else throw badTerm("invalid argument value", eVal);
|
||||
|
||||
argsNF = ATappend(argsNF,
|
||||
argsNF = ATinsert(argsNF,
|
||||
ATmake("Tup(Str(<str>), <term>)", name.c_str(), eVal));
|
||||
|
||||
args = ATgetNext(args);
|
||||
}
|
||||
|
||||
argsNF = ATreverse(argsNF);
|
||||
}
|
||||
|
||||
|
||||
Expr substExpr(string x, Expr rep, Expr e)
|
||||
{
|
||||
char * s;
|
||||
Expr e2;
|
||||
|
||||
if (ATmatch(e, "Var(<str>)", &s))
|
||||
if (x == s)
|
||||
return rep;
|
||||
else
|
||||
return e;
|
||||
|
||||
if (ATmatch(e, "Lam(<str>, <term>)", &s, &e2))
|
||||
if (x == s)
|
||||
return e;
|
||||
/* !!! unfair substitutions */
|
||||
|
||||
/* Generically substitute in subterms. */
|
||||
|
||||
if (ATgetType(e) == AT_APPL) {
|
||||
AFun fun = ATgetAFun(e);
|
||||
int arity = ATgetArity(fun);
|
||||
ATermList args = ATempty;
|
||||
|
||||
for (int i = arity - 1; i >= 0; i--)
|
||||
args = ATinsert(args, substExpr(x, rep, ATgetArgument(e, i)));
|
||||
|
||||
return (ATerm) ATmakeApplList(fun, args);
|
||||
}
|
||||
|
||||
if (ATgetType(e) == AT_LIST) {
|
||||
ATermList in = (ATermList) e;
|
||||
ATermList out = ATempty;
|
||||
|
||||
while (!ATisEmpty(in)) {
|
||||
out = ATinsert(out, substExpr(x, rep, ATgetFirst(in)));
|
||||
in = ATgetNext(in);
|
||||
}
|
||||
|
||||
return (ATerm) ATreverse(out);
|
||||
}
|
||||
|
||||
throw badTerm("do not know how to substitute", e);
|
||||
}
|
||||
|
||||
|
||||
/* Evaluate an expression. */
|
||||
Expr evalValue(Expr e)
|
||||
{
|
||||
char * s;
|
||||
Expr eBuildPlatform, eProg, e2;
|
||||
Expr eBuildPlatform, eProg, e2, e3, e4;
|
||||
ATermList args;
|
||||
|
||||
/* Normal forms. */
|
||||
if (ATmatch(e, "Str(<str>)", &s) ||
|
||||
ATmatch(e, "Bool(True)") ||
|
||||
ATmatch(e, "Bool(False)"))
|
||||
ATmatch(e, "Bool(False)") ||
|
||||
ATmatch(e, "Lam(<str>, <term>)", &s, &e2))
|
||||
return e;
|
||||
|
||||
/* Value references. */
|
||||
|
@ -282,6 +329,14 @@ Expr evalValue(Expr e)
|
|||
return evalValue(e3);
|
||||
}
|
||||
|
||||
/* Application. */
|
||||
if (ATmatch(e, "App(<term>, <term>)", &e2, &e3)) {
|
||||
e2 = evalValue(e2);
|
||||
if (!ATmatch(e2, "Lam(<str>, <term>)", &s, &e4))
|
||||
throw badTerm("expecting lambda", e2);
|
||||
return evalValue(substExpr(s, e3, e4));
|
||||
}
|
||||
|
||||
/* Execution primitive. */
|
||||
|
||||
if (ATmatch(e, "Exec(<term>, <term>, [<list>])",
|
||||
|
|
|
@ -60,6 +60,12 @@ using namespace std;
|
|||
makeArg(Arg(Str(nm), (Bool(True), _))) => (nm, "1")
|
||||
makeArg(Arg(Str(nm), (Bool(False), _))) => (nm, undef)
|
||||
|
||||
subst(x, e1, e2) is defined as a generic topdown term
|
||||
traversal of e2, replacing each `Var(x)' with e1, and not
|
||||
descending into `Lam(x, _)'.
|
||||
|
||||
Note: all stored expressions must be closed. !!! ugly
|
||||
|
||||
getFile :: Hash -> FileName
|
||||
loadExpr :: Hash -> FileName
|
||||
hashExpr :: Expr -> Hash
|
||||
|
@ -76,6 +82,9 @@ Expr evalValue(Expr e);
|
|||
/* Return a canonical textual representation of an expression. */
|
||||
string printExpr(Expr e);
|
||||
|
||||
/* Perform variable substitution. */
|
||||
Expr substExpr(string x, Expr rep, Expr e);
|
||||
|
||||
/* Hash an expression. */
|
||||
Hash hashExpr(Expr e);
|
||||
|
||||
|
|
|
@ -69,6 +69,9 @@ void runTests()
|
|||
evalTest(ATmake("Str(\"Hello World\")"));
|
||||
evalTest(ATmake("Bool(True)"));
|
||||
evalTest(ATmake("Bool(False)"));
|
||||
evalTest(ATmake("App(Lam(\"x\", Var(\"x\")), Str(\"Hello World\"))"));
|
||||
evalTest(ATmake("App(App(Lam(\"x\", Lam(\"y\", Var(\"x\"))), Str(\"Hello World\")), Str(\"Hallo Wereld\"))"));
|
||||
evalTest(ATmake("App(Lam(\"sys\", Lam(\"x\", [Var(\"x\"), Var(\"sys\")])), Str(\"i686-suse-linux\"))"));
|
||||
|
||||
Hash builder1 = addValue("./test-builder-1.sh");
|
||||
|
||||
|
|
Loading…
Reference in a new issue