[commit: ghc] supercompiler: Fix some long-standing binder-FV issues, especially in evaluator FVs (d0da162)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : supercompiler

http://hackage.haskell.org/trac/ghc/changeset/d0da1626611887055e41b769a03cca9b8ec78b3d

>---------------------------------------------------------------

commit d0da1626611887055e41b769a03cca9b8ec78b3d
Author: Max Bolingbroke <[email protected]>
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')