From: simonpj@microsoft.com <unknown>
Date: Thu, 3 May 2007 12:47:59 +0000 (+0000)
Subject: Fix dependency information for RULES
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=59a4ad63f93f4fd7b8ede74bb2ea36778fe25e06

Fix dependency information for RULES

A SpecInfo (inside IdInfo) keeps track of the free variables of a RULE
so that the occurrency analyser knows about its dependencies.

Previously it was only tracking the *rhs* free vars, but it should
really include the *lhs* ones too.  See Note [Rule dependency info]
in IdInfo.

This fixes a WARNING when compiling some libraries.
---

diff --git a/compiler/basicTypes/IdInfo.lhs b/compiler/basicTypes/IdInfo.lhs
index b009794..a3124f3 100644
--- a/compiler/basicTypes/IdInfo.lhs
+++ b/compiler/basicTypes/IdInfo.lhs
@@ -464,9 +464,11 @@ type InlinePragInfo = Activation
 %************************************************************************
 
 \begin{code}
--- CoreRules is used only in an idSpecialisation (move to IdInfo?)
 data SpecInfo 
-  = SpecInfo [CoreRule] VarSet	-- Locally-defined free vars of RHSs
+  = SpecInfo 
+	[CoreRule] 
+	VarSet		-- Locally-defined free vars of *both* LHS and RHS of rules
+			-- Note [Rule dependency info]
 
 emptySpecInfo :: SpecInfo
 emptySpecInfo = SpecInfo [] emptyVarSet
@@ -483,6 +485,17 @@ specInfoRules (SpecInfo rules _) = rules
 seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
 \end{code}
 
+Note [Rule dependency info]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+THe VarSet in a SpecInfo is used for dependency analysis in the 
+occurrence analyser.  We must track free vars in *both* lhs and rhs.  Why both?  
+Consider
+	x = y
+ 	RULE f x = 4
+Then if we substitute y for x, we'd better do so in the
+ rule's LHS too, so we'd better ensure the dependency is respsected
+
+
 
 %************************************************************************
 %*									*
diff --git a/compiler/coreSyn/CoreFVs.lhs b/compiler/coreSyn/CoreFVs.lhs
index bda9342..807b76c 100644
--- a/compiler/coreSyn/CoreFVs.lhs
+++ b/compiler/coreSyn/CoreFVs.lhs
@@ -14,7 +14,7 @@ module CoreFVs (
 	exprFreeNames, exprsFreeNames,
 
 	idRuleVars, idFreeVars, varTypeTyVars, 
-	ruleRhsFreeVars, rulesRhsFreeVars,
+	ruleRhsFreeVars, rulesFreeVars,
 	ruleLhsFreeNames, ruleLhsFreeIds, 
 
 	CoreExprWithFVs,	-- = AnnExpr Id VarSet
@@ -241,18 +241,18 @@ exprsFreeNames es = foldr (unionNameSets . exprFreeNames) emptyNameSet es
 ruleRhsFreeVars :: CoreRule -> VarSet
 ruleRhsFreeVars (BuiltinRule {}) = noFVs
 ruleRhsFreeVars (Rule { ru_fn = fn, ru_bndrs = bndrs, ru_rhs = rhs })
-  = delFromUFM fvs fn
-	-- Hack alert!
-	-- Don't include the Id in its own rhs free-var set.
-	-- Otherwise the occurrence analyser makes bindings recursive
-	-- that shoudn't be.  E.g.
-	--	RULE:  f (f x y) z  ==>  f x (f y z)
+  = delFromUFM fvs fn	 -- Note [Rule free var hack]
   where
     fvs = addBndrs bndrs (expr_fvs rhs) isLocalVar emptyVarSet
 
-rulesRhsFreeVars :: [CoreRule] -> VarSet
-rulesRhsFreeVars rules
-  = foldr (unionVarSet . ruleRhsFreeVars) emptyVarSet rules
+ruleFreeVars :: CoreRule -> VarSet	-- All free variables, both left and right
+ruleFreeVars (Rule { ru_fn = fn, ru_bndrs = bndrs, ru_rhs = rhs, ru_args = args })
+  = delFromUFM fvs fn	-- Note [Rule free var hack]
+  where
+    fvs = addBndrs bndrs (exprs_fvs (rhs:args)) isLocalVar emptyVarSet
+
+rulesFreeVars :: [CoreRule] -> VarSet
+rulesFreeVars rules = foldr (unionVarSet . ruleFreeVars) emptyVarSet rules
 
 ruleLhsFreeIds :: CoreRule -> VarSet
 -- This finds all locally-defined free Ids on the LHS of the rule
@@ -261,6 +261,14 @@ ruleLhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args })
   = addBndrs bndrs (exprs_fvs args) isLocalId emptyVarSet
 \end{code}
 
+Note [Rule free var hack]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+Don't include the Id in its own rhs free-var set.
+Otherwise the occurrence analyser makes bindings recursive
+that shoudn't be.  E.g.
+	RULE:  f (f x y) z  ==>  f x (f y z)
+
+Also since rule_fn is a Name, not a Var, we have to use the grungy delUFM.
 
 %************************************************************************
 %*									*
diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs
index fb0ad40..ed9f238 100644
--- a/compiler/specialise/Rules.lhs
+++ b/compiler/specialise/Rules.lhs
@@ -20,7 +20,7 @@ module Rules (
 
 import CoreSyn		-- All of it
 import OccurAnal	( occurAnalyseExpr )
-import CoreFVs		( exprFreeVars, exprsFreeVars, bindFreeVars, rulesRhsFreeVars )
+import CoreFVs		( exprFreeVars, exprsFreeVars, bindFreeVars, rulesFreeVars )
 import CoreUnfold	( isCheapUnfolding, unfoldingTemplate )
 import CoreUtils	( tcEqExprX, exprType )
 import PprCore		( pprRules )
@@ -136,11 +136,11 @@ ruleCantMatch ts	     as		    = False
 
 \begin{code}
 mkSpecInfo :: [CoreRule] -> SpecInfo
-mkSpecInfo rules = SpecInfo rules (rulesRhsFreeVars rules)
+mkSpecInfo rules = SpecInfo rules (rulesFreeVars rules)
 
 extendSpecInfo :: SpecInfo -> [CoreRule] -> SpecInfo
 extendSpecInfo (SpecInfo rs1 fvs1) rs2
-  = SpecInfo (rs2 ++ rs1) (rulesRhsFreeVars rs2 `unionVarSet` fvs1)
+  = SpecInfo (rs2 ++ rs1) (rulesFreeVars rs2 `unionVarSet` fvs1)
 
 addSpecInfo :: SpecInfo -> SpecInfo -> SpecInfo
 addSpecInfo (SpecInfo rs1 fvs1) (SpecInfo rs2 fvs2)