projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix Trac #1988; keep the ru_fn field of a RULE up to date
[ghc-hetmet.git]
/
compiler
/
basicTypes
/
IdInfo.lhs
diff --git
a/compiler/basicTypes/IdInfo.lhs
b/compiler/basicTypes/IdInfo.lhs
index
c1a69b2
..
7eacbd8
100644
(file)
--- a/
compiler/basicTypes/IdInfo.lhs
+++ b/
compiler/basicTypes/IdInfo.lhs
@@
-12,7
+12,7
@@
Haskell. [WDP 94/11])
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
module IdInfo (
-- for details
module IdInfo (
@@
-72,7
+72,7
@@
module IdInfo (
-- Specialisation
SpecInfo(..), specInfo, setSpecInfo, isEmptySpecInfo,
-- Specialisation
SpecInfo(..), specInfo, setSpecInfo, isEmptySpecInfo,
- specInfoFreeVars, specInfoRules, seqSpecInfo,
+ specInfoFreeVars, specInfoRules, seqSpecInfo, setSpecInfoHead,
-- CAF info
CafInfo(..), cafInfo, ppCafInfo, setCafInfo, mayHaveCafRefs,
-- CAF info
CafInfo(..), cafInfo, ppCafInfo, setCafInfo, mayHaveCafRefs,
@@
-89,6
+89,7
@@
module IdInfo (
import CoreSyn
import Class
import PrimOp
import CoreSyn
import Class
import PrimOp
+import Name
import Var
import VarSet
import BasicTypes
import Var
import VarSet
import BasicTypes
@@
-102,7
+103,6
@@
import Module
import Data.Maybe
#ifdef OLD_STRICTNESS
import Data.Maybe
#ifdef OLD_STRICTNESS
-import Name
import Demand
import qualified Demand
import Util
import Demand
import qualified Demand
import Util
@@
-474,7
+474,9
@@
type InlinePragInfo = Activation
data SpecInfo
= SpecInfo
[CoreRule]
data SpecInfo
= SpecInfo
[CoreRule]
- VarSet -- Locally-defined free vars of *both* LHS and RHS of rules
+ VarSet -- Locally-defined free vars of *both* LHS and RHS
+ -- of rules. I don't think it needs to include the
+ -- ru_fn though.
-- Note [Rule dependency info]
emptySpecInfo :: SpecInfo
-- Note [Rule dependency info]
emptySpecInfo :: SpecInfo
@@
-489,6
+491,12
@@
specInfoFreeVars (SpecInfo _ fvs) = fvs
specInfoRules :: SpecInfo -> [CoreRule]
specInfoRules (SpecInfo rules _) = rules
specInfoRules :: SpecInfo -> [CoreRule]
specInfoRules (SpecInfo rules _) = rules
+setSpecInfoHead :: Name -> SpecInfo -> SpecInfo
+setSpecInfoHead fn (SpecInfo rules fvs)
+ = SpecInfo (map set_head rules) fvs
+ where
+ set_head rule = rule { ru_fn = fn }
+
seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
\end{code}
seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
\end{code}
@@
-500,7
+508,7
@@
Consider
x = y
RULE f x = 4
Then if we substitute y for x, we'd better do so in the
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
+ rule's LHS too, so we'd better ensure the dependency is respected
@@
-704,11
+712,11
@@
zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand})
-- The "unsafe" occ info is the ones that say I'm not in a lambda
-- because that might not be true for an unsaturated lambda
is_safe_occ (OneOcc in_lam _ _) = in_lam
-- The "unsafe" occ info is the ones that say I'm not in a lambda
-- because that might not be true for an unsaturated lambda
is_safe_occ (OneOcc in_lam _ _) = in_lam
- is_safe_occ other = True
+ is_safe_occ _other = True
safe_occ = case occ of
OneOcc _ once int_cxt -> OneOcc insideLam once int_cxt
safe_occ = case occ of
OneOcc _ once int_cxt -> OneOcc insideLam once int_cxt
- other -> occ
+ _other -> occ
is_safe_dmd Nothing = True
is_safe_dmd (Just dmd) = not (isStrictDmd dmd)
is_safe_dmd Nothing = True
is_safe_dmd (Just dmd) = not (isStrictDmd dmd)
@@
-724,9
+732,13
@@
zapDemandInfo info@(IdInfo {newDemandInfo = dmd})
\begin{code}
zapFragileInfo :: IdInfo -> Maybe IdInfo
-- Zap info that depends on free variables
\begin{code}
zapFragileInfo :: IdInfo -> Maybe IdInfo
-- Zap info that depends on free variables
-zapFragileInfo info = Just (info `setSpecInfo` emptySpecInfo
- `setWorkerInfo` NoWorker
- `setUnfoldingInfo` NoUnfolding)
+zapFragileInfo info
+ = Just (info `setSpecInfo` emptySpecInfo
+ `setWorkerInfo` NoWorker
+ `setUnfoldingInfo` NoUnfolding
+ `setOccInfo` if isFragileOcc occ then NoOccInfo else occ)
+ where
+ occ = occInfo info
\end{code}
%************************************************************************
\end{code}
%************************************************************************