forked from lix-project/lix
* Detect infinite loops using blackholing.
This commit is contained in:
parent
2e16ff22ac
commit
dc0ef2ca98
16
src/fix.cc
16
src/fix.cc
|
@ -18,6 +18,13 @@ struct EvalState
|
||||||
NormalForms normalForms;
|
NormalForms normalForms;
|
||||||
PkgPaths pkgPaths;
|
PkgPaths pkgPaths;
|
||||||
PkgHashes pkgHashes; /* normalised package hashes */
|
PkgHashes pkgHashes; /* normalised package hashes */
|
||||||
|
Expr blackHole;
|
||||||
|
|
||||||
|
EvalState()
|
||||||
|
{
|
||||||
|
blackHole = ATmake("BlackHole()");
|
||||||
|
if (!blackHole) throw Error("cannot build black hole");
|
||||||
|
}
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
||||||
|
@ -64,8 +71,6 @@ static Expr substExpr(string x, Expr rep, Expr e)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* ??? unfair substitutions? */
|
|
||||||
|
|
||||||
/* Generically substitute in subterms. */
|
/* Generically substitute in subterms. */
|
||||||
|
|
||||||
if (ATgetType(e) == AT_APPL) {
|
if (ATgetType(e) == AT_APPL) {
|
||||||
|
@ -345,9 +350,14 @@ static Expr evalExpr(EvalState & state, Expr e)
|
||||||
/* Consult the memo table to quickly get the normal form of
|
/* Consult the memo table to quickly get the normal form of
|
||||||
previously evaluated expressions. */
|
previously evaluated expressions. */
|
||||||
NormalForms::iterator i = state.normalForms.find(e);
|
NormalForms::iterator i = state.normalForms.find(e);
|
||||||
if (i != state.normalForms.end()) return i->second;
|
if (i != state.normalForms.end()) {
|
||||||
|
if (i->second == state.blackHole)
|
||||||
|
throw badTerm("infinite recursion", e);
|
||||||
|
return i->second;
|
||||||
|
}
|
||||||
|
|
||||||
/* Otherwise, evaluate and memoize. */
|
/* Otherwise, evaluate and memoize. */
|
||||||
|
state.normalForms[e] = state.blackHole;
|
||||||
Expr nf = evalExpr2(state, e);
|
Expr nf = evalExpr2(state, e);
|
||||||
state.normalForms[e] = nf;
|
state.normalForms[e] = nf;
|
||||||
return nf;
|
return nf;
|
||||||
|
|
1
testpkgs/infrec/infrec.fix
Normal file
1
testpkgs/infrec/infrec.fix
Normal file
|
@ -0,0 +1 @@
|
||||||
|
IncludeFix("infrec/infrec.fix")
|
Loading…
Reference in a new issue