From: simonpj <unknown>
Date: Fri, 8 Jul 2005 16:16:37 +0000 (+0000)
Subject: [project @ 2005-07-08 16:16:37 by simonpj]
X-Git-Tag: Initial_conversion_from_CVS_complete~394
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=3a99265e73e75bc69f243ff6845e27fd92445d0d;p=ghc-hetmet.git

[project @ 2005-07-08 16:16:37 by simonpj]
MERGE TO STABLE (once I"ve checked it works)

The dictionary-floating code in Specialise wasn't taking
variables free in the RULES into account, which resulted in
such variables perhaps going out of scope.
---

diff --git a/ghc/compiler/specialise/Specialise.lhs b/ghc/compiler/specialise/Specialise.lhs
index 086e7b0..baca12c 100644
--- a/ghc/compiler/specialise/Specialise.lhs
+++ b/ghc/compiler/specialise/Specialise.lhs
@@ -23,7 +23,7 @@ import VarSet
 import VarEnv
 import CoreSyn
 import CoreUtils	( applyTypeToArgs, mkPiTypes )
-import CoreFVs		( exprFreeVars, exprsFreeVars )
+import CoreFVs		( exprFreeVars, exprsFreeVars, idRuleVars )
 import CoreTidy		( tidyRules )
 import CoreLint		( showPass, endPass )
 import Rules		( addIdSpecialisations, mkLocalRule, lookupRule, emptyRuleBase, rulesOfBinds )
@@ -1050,11 +1050,16 @@ zapCalls ids uds = uds {calls = delListFromFM (calls uds) ids}
 
 mkDB bind = (bind, bind_fvs bind)
 
-bind_fvs (NonRec bndr rhs) = exprFreeVars rhs
+bind_fvs (NonRec bndr rhs) = pair_fvs (bndr,rhs)
 bind_fvs (Rec prs)	   = foldl delVarSet rhs_fvs bndrs
 			   where
 			     bndrs = map fst prs
-			     rhs_fvs = unionVarSets [exprFreeVars rhs | (bndr,rhs) <- prs]
+			     rhs_fvs = unionVarSets (map pair_fvs prs)
+
+pair_fvs (bndr, rhs) = exprFreeVars rhs `unionVarSet` idRuleVars bndr
+	-- Don't forget variables mentioned in the
+	-- rules of the bndr.  C.f. OccAnal.addRuleUsage
+
 
 addDictBind (dict,rhs) uds = uds { dict_binds = mkDB (NonRec dict rhs) `consBag` dict_binds uds }