summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorsimonpj@microsoft.com <unknown>2007-05-03 12:47:59 +0000
committersimonpj@microsoft.com <unknown>2007-05-03 12:47:59 +0000
commit59a4ad63f93f4fd7b8ede74bb2ea36778fe25e06 (patch)
tree453586dc4e28f58a309e66b59e794e5aa9b81cc0
parentde905f504a3e129e2c4a1906d7e0a26e36cd6c4b (diff)
downloadhaskell-59a4ad63f93f4fd7b8ede74bb2ea36778fe25e06.tar.gz
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.
-rw-r--r--compiler/basicTypes/IdInfo.lhs17
-rw-r--r--compiler/coreSyn/CoreFVs.lhs28
-rw-r--r--compiler/specialise/Rules.lhs6
3 files changed, 36 insertions, 15 deletions
diff --git a/compiler/basicTypes/IdInfo.lhs b/compiler/basicTypes/IdInfo.lhs
index b009794fb8..a3124f3594 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 bda9342f7b..807b76c02e 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 fb0ad40124..ed9f2388bc 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)