Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : supercompiler
http://hackage.haskell.org/trac/ghc/changeset/d0da1626611887055e41b769a03cca9b8ec78b3d >--------------------------------------------------------------- commit d0da1626611887055e41b769a03cca9b8ec78b3d Author: Max Bolingbroke <batterseapo...@hotmail.com> Date: Fri Apr 27 10:55:04 2012 +0100 Fix some long-standing binder-FV issues, especially in evaluator FVs >--------------------------------------------------------------- .../supercompile/Supercompile/Core/FreeVars.hs | 2 +- .../Supercompile/Evaluator/FreeVars.hs | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/supercompile/Supercompile/Core/FreeVars.hs b/compiler/supercompile/Supercompile/Core/FreeVars.hs index c00cc6a..47c1c5e 100644 --- a/compiler/supercompile/Supercompile/Core/FreeVars.hs +++ b/compiler/supercompile/Supercompile/Core/FreeVars.hs @@ -77,7 +77,7 @@ mkFreeVars rec = (unitVarSet, term, term', alternatives, value, value') value = rec value' value' (Indirect x) = unitVarSet x - value' (TyLambda x e) = term e `delVarSet` x + value' (TyLambda x e) = nonRecBinderFreeVars x (term e) value' (Lambda x e) = nonRecBinderFreeVars x (term e) value' (Data _ tys cos xs) = unionVarSets (map typ tys) `unionVarSet` unionVarSets (map tyCoVarsOfCo cos) `unionVarSet` mkVarSet xs value' (Literal _) = emptyVarSet diff --git a/compiler/supercompile/Supercompile/Evaluator/FreeVars.hs b/compiler/supercompile/Supercompile/Evaluator/FreeVars.hs index d65597c..a8d8e72 100644 --- a/compiler/supercompile/Supercompile/Evaluator/FreeVars.hs +++ b/compiler/supercompile/Supercompile/Evaluator/FreeVars.hs @@ -48,10 +48,10 @@ stackFrameOpenFreeVars kf = case kf of TyApply ty' -> (emptyVarSet, tyVarsOfType ty') CoApply co' -> (emptyVarSet, tyCoVarsOfCo co') Apply x' -> (emptyVarSet, unitVarSet x') - Scrutinise x' ty in_alts -> (emptyVarSet, (inFreeVars annedAltsFreeVars in_alts `delVarSet` x') `unionVarSet` tyVarsOfType ty) + Scrutinise x' ty in_alts -> (emptyVarSet, (nonRecBinderFreeVars x' (inFreeVars annedAltsFreeVars in_alts)) `unionVarSet` tyVarsOfType ty) PrimApply _ tys as in_es -> (emptyVarSet, unionVarSets (map tyVarsOfType tys) `unionVarSet` unionVarSets (map annedFreeVars as) `unionVarSet` unionVarSets (map (inFreeVars annedTermFreeVars) in_es)) - StrictLet x' in_e2 -> (emptyVarSet, inFreeVars annedTermFreeVars in_e2 `delVarSet` x') - Update x' -> (unitVarSet x', emptyVarSet) + StrictLet x' in_e2 -> (emptyVarSet, nonRecBinderFreeVars x' (inFreeVars annedTermFreeVars in_e2)) + Update x' -> (unitVarSet x', varBndrFreeVars x') CastIt co' -> (emptyVarSet, tyCoVarsOfCo co') _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
