Move seqExpr, seqIdInfo etc to CoreUtils

Refactoring only : it just brings some scattered "seq" code together

5 files changed, 112 insertions, 111 deletions

diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs
index a3ed5b97d4..cebf6d010c 100644
--- a/compiler/basicTypes/Id.hs
+++ b/compiler/basicTypes/Id.hs
@@ -198,7 +198,7 @@ lazySetIdInfo :: Id -> IdInfo -> Id
 lazySetIdInfo = Var.lazySetIdInfo
 
 setIdInfo :: Id -> IdInfo -> Id
-setIdInfo id info = seqIdInfo info `seq` (lazySetIdInfo id info)
+setIdInfo id info = info `seq` (lazySetIdInfo id info)
         -- Try to avoid spack leaks by seq'ing
 
 modifyIdInfo :: (IdInfo -> IdInfo) -> Id -> Id
diff --git a/compiler/basicTypes/IdInfo.hs b/compiler/basicTypes/IdInfo.hs
index eb897896a9..e9fccbec23 100644
--- a/compiler/basicTypes/IdInfo.hs
+++ b/compiler/basicTypes/IdInfo.hs
@@ -15,7 +15,6 @@ module IdInfo (
         -- * The IdInfo type
         IdInfo,         -- Abstract
         vanillaIdInfo, noCafIdInfo,
-        seqIdInfo, megaSeqIdInfo,
 
         -- ** The OneShotInfo type
         OneShotInfo(..),
@@ -56,7 +55,7 @@ module IdInfo (
         SpecInfo(..),
         emptySpecInfo,
         isEmptySpecInfo, specInfoFreeVars,
-        specInfoRules, seqSpecInfo, setSpecInfoHead,
+        specInfoRules, setSpecInfoHead,
         specInfo, setSpecInfo,
 
         -- ** The CAFInfo type
@@ -194,35 +193,6 @@ data IdInfo
                                          -- n <=> all calls have at least n arguments
     }
 
--- | Just evaluate the 'IdInfo' to WHNF
-seqIdInfo :: IdInfo -> ()
-seqIdInfo (IdInfo {}) = ()
-
--- | Evaluate all the fields of the 'IdInfo' that are generally demanded by the
--- compiler
-megaSeqIdInfo :: IdInfo -> ()
-megaSeqIdInfo info
-  = seqSpecInfo (specInfo info)                 `seq`
-
--- Omitting this improves runtimes a little, presumably because
--- some unfoldings are not calculated at all
---    seqUnfolding (unfoldingInfo info)         `seq`
-
-    seqDemandInfo (demandInfo info)             `seq`
-    seqStrictnessInfo (strictnessInfo info)     `seq`
-    seqCaf (cafInfo info)                       `seq`
-    seqOneShot (oneShotInfo info)               `seq`
-    seqOccInfo (occInfo info)
-
-seqOneShot :: OneShotInfo -> ()
-seqOneShot l = l `seq` ()
-
-seqStrictnessInfo :: StrictSig -> ()
-seqStrictnessInfo ty = seqStrictSig ty
-
-seqDemandInfo :: Demand -> ()
-seqDemandInfo dmd = seqDemand dmd
-
 -- Setters
 
 setSpecInfo :: IdInfo -> SpecInfo -> IdInfo
@@ -400,9 +370,6 @@ setSpecInfoHead :: Name -> SpecInfo -> SpecInfo
 setSpecInfoHead fn (SpecInfo rules fvs)
   = SpecInfo (map (setRuleIdName fn) rules) fvs
 
-seqSpecInfo :: SpecInfo -> ()
-seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
-
 {-
 ************************************************************************
 *                                                                      *
@@ -434,9 +401,6 @@ mayHaveCafRefs :: CafInfo -> Bool
 mayHaveCafRefs  MayHaveCafRefs = True
 mayHaveCafRefs _               = False
 
-seqCaf :: CafInfo -> ()
-seqCaf c = c `seq` ()
-
 instance Outputable CafInfo where
    ppr = ppCafInfo
 
diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs
index e614c93b51..98400c42a3 100644
--- a/compiler/coreSyn/CoreSyn.hs
+++ b/compiler/coreSyn/CoreSyn.hs
@@ -58,9 +58,6 @@ module CoreSyn (
         isClosedUnfolding, hasSomeUnfolding,
         canUnfold, neverUnfoldGuidance, isStableSource,
 
-        -- * Strictness
-        seqExpr, seqExprs, seqUnfolding,
-
         -- * Annotated expression data types
         AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,
 
@@ -75,7 +72,7 @@ module CoreSyn (
         RuleName, RuleFun, IdUnfoldingFun, InScopeEnv,
 
         -- ** Operations on 'CoreRule's
-        seqRules, ruleArity, ruleName, ruleIdName, ruleActivation,
+        ruleArity, ruleName, ruleIdName, ruleActivation,
         setRuleIdName,
         isBuiltinRule, isLocalRule, isAutoRule,
 
@@ -1023,19 +1020,6 @@ evaldUnfolding = OtherCon []
 mkOtherCon :: [AltCon] -> Unfolding
 mkOtherCon = OtherCon
 
-seqUnfolding :: Unfolding -> ()
-seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
-                uf_is_value = b1, uf_is_work_free = b2,
-                uf_expandable = b3, uf_is_conlike = b4,
-                uf_guidance = g})
-  = seqExpr e `seq` top `seq` b1 `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
-
-seqUnfolding _ = ()
-
-seqGuidance :: UnfoldingGuidance -> ()
-seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
-seqGuidance _                      = ()
-
 isStableSource :: UnfoldingSource -> Bool
 -- Keep the unfolding template
 isStableSource InlineCompulsory   = True
@@ -1574,61 +1558,6 @@ valArgCount = count isValArg
 {-
 ************************************************************************
 *                                                                      *
-\subsection{Seq stuff}
-*                                                                      *
-************************************************************************
--}
-
-seqExpr :: CoreExpr -> ()
-seqExpr (Var v)         = v `seq` ()
-seqExpr (Lit lit)       = lit `seq` ()
-seqExpr (App f a)       = seqExpr f `seq` seqExpr a
-seqExpr (Lam b e)       = seqBndr b `seq` seqExpr e
-seqExpr (Let b e)       = seqBind b `seq` seqExpr e
-seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
-seqExpr (Cast e co)     = seqExpr e `seq` seqCo co
-seqExpr (Tick n e)      = seqTickish n `seq` seqExpr e
-seqExpr (Type t)        = seqType t
-seqExpr (Coercion co)   = seqCo co
-
-seqExprs :: [CoreExpr] -> ()
-seqExprs [] = ()
-seqExprs (e:es) = seqExpr e `seq` seqExprs es
-
-seqTickish :: Tickish Id -> ()
-seqTickish ProfNote{ profNoteCC = cc } = cc `seq` ()
-seqTickish HpcTick{} = ()
-seqTickish Breakpoint{ breakpointFVs = ids } = seqBndrs ids
-seqTickish SourceNote{} = ()
-
-seqBndr :: CoreBndr -> ()
-seqBndr b = b `seq` ()
-
-seqBndrs :: [CoreBndr] -> ()
-seqBndrs [] = ()
-seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
-
-seqBind :: Bind CoreBndr -> ()
-seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
-seqBind (Rec prs)    = seqPairs prs
-
-seqPairs :: [(CoreBndr, CoreExpr)] -> ()
-seqPairs [] = ()
-seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
-
-seqAlts :: [CoreAlt] -> ()
-seqAlts [] = ()
-seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
-
-seqRules :: [CoreRule] -> ()
-seqRules [] = ()
-seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
-  = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
-seqRules (BuiltinRule {} : rules) = seqRules rules
-
-{-
-************************************************************************
-*                                                                      *
 \subsection{Annotated core}
 *                                                                      *
 ************************************************************************
diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs
index d7344e1188..5e7ffdfc98 100644
--- a/compiler/coreSyn/CoreUtils.hs
+++ b/compiler/coreSyn/CoreUtils.hs
@@ -39,6 +39,10 @@ module CoreUtils (
         -- * Eta reduction
         tryEtaReduce,
 
+        -- * Seq
+        seqExpr, seqExprs, seqUnfolding, seqRules,
+        seqIdInfo, megaSeqIdInfo, seqSpecInfo, seqBinds,
+
         -- * Manipulating data constructors and types
         applyTypeToArgs, applyTypeToArg,
         dataConRepInstPat, dataConRepFSInstPat,
@@ -62,6 +66,8 @@ import Name
 import Literal
 import DataCon
 import PrimOp
+import Demand( seqDemand, seqStrictSig )
+import BasicTypes( seqOccInfo )
 import Id
 import IdInfo
 import Type
@@ -1697,6 +1703,108 @@ locBind loc b1 b2 diffs = map addLoc diffs
 {-
 ************************************************************************
 *                                                                      *
+\subsection{Seq stuff}
+*                                                                      *
+************************************************************************
+-}
+
+seqExpr :: CoreExpr -> ()
+seqExpr (Var v)         = v `seq` ()
+seqExpr (Lit lit)       = lit `seq` ()
+seqExpr (App f a)       = seqExpr f `seq` seqExpr a
+seqExpr (Lam b e)       = seqBndr b `seq` seqExpr e
+seqExpr (Let b e)       = seqBind b `seq` seqExpr e
+seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
+seqExpr (Cast e co)     = seqExpr e `seq` seqCo co
+seqExpr (Tick n e)      = seqTickish n `seq` seqExpr e
+seqExpr (Type t)        = seqType t
+seqExpr (Coercion co)   = seqCo co
+
+seqExprs :: [CoreExpr] -> ()
+seqExprs [] = ()
+seqExprs (e:es) = seqExpr e `seq` seqExprs es
+
+seqTickish :: Tickish Id -> ()
+seqTickish ProfNote{ profNoteCC = cc } = cc `seq` ()
+seqTickish HpcTick{} = ()
+seqTickish Breakpoint{ breakpointFVs = ids } = seqBndrs ids
+seqTickish SourceNote{} = ()
+
+seqBndr :: CoreBndr -> ()
+seqBndr b | isTyVar b = seqType (tyVarKind b)
+          | otherwise = seqType (varType b)             `seq`
+                        megaSeqIdInfo (idInfo b)
+
+seqBndrs :: [CoreBndr] -> ()
+seqBndrs [] = ()
+seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
+
+seqBinds :: [Bind CoreBndr] -> ()
+seqBinds bs = foldr (seq . seqBind) () bs
+
+seqBind :: Bind CoreBndr -> ()
+seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
+seqBind (Rec prs)    = seqPairs prs
+
+seqPairs :: [(CoreBndr, CoreExpr)] -> ()
+seqPairs [] = ()
+seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
+
+seqAlts :: [CoreAlt] -> ()
+seqAlts [] = ()
+seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
+
+seqRules :: [CoreRule] -> ()
+seqRules [] = ()
+seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
+  = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
+seqRules (BuiltinRule {} : rules) = seqRules rules
+
+seqUnfolding :: Unfolding -> ()
+seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
+                uf_is_value = b1, uf_is_work_free = b2,
+                uf_expandable = b3, uf_is_conlike = b4,
+                uf_guidance = g})
+  = seqExpr e `seq` top `seq` b1 `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
+
+seqUnfolding _ = ()
+
+seqGuidance :: UnfoldingGuidance -> ()
+seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
+seqGuidance _                      = ()
+
+-- | Just evaluate the 'IdInfo' to WHNF
+seqIdInfo :: IdInfo -> ()
+seqIdInfo info = info `seq` ()
+
+-- | Evaluate all the fields of the 'IdInfo' that are generally demanded by the
+-- compiler
+megaSeqIdInfo :: IdInfo -> ()
+megaSeqIdInfo info
+  = seqSpecInfo (specInfo info)                 `seq`
+
+-- Omitting this improves runtimes a little, presumably because
+-- some unfoldings are not calculated at all
+--    seqUnfolding (unfoldingInfo info)         `seq`
+
+    seqDemand (demandInfo info)                 `seq`
+    seqStrictSig (strictnessInfo info)          `seq`
+    seqCaf (cafInfo info)                       `seq`
+    seqOneShot (oneShotInfo info)               `seq`
+    seqOccInfo (occInfo info)
+
+seqOneShot :: OneShotInfo -> ()
+seqOneShot l = l `seq` ()
+
+seqSpecInfo :: SpecInfo -> ()
+seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
+
+seqCaf :: CafInfo -> ()
+seqCaf c = c `seq` ()
+
+{-
+************************************************************************
+*                                                                      *
 \subsection{The size of an expression}
 *                                                                      *
 ************************************************************************
diff --git a/compiler/coreSyn/PprCore.hs b/compiler/coreSyn/PprCore.hs
index ecea85021c..c0af96886d 100644
--- a/compiler/coreSyn/PprCore.hs
+++ b/compiler/coreSyn/PprCore.hs
@@ -340,7 +340,7 @@ pprIdBndrInfo info
   = sdocWithDynFlags $ \dflags ->
     if gopt Opt_SuppressIdInfo dflags
     then empty
-    else megaSeqIdInfo info `seq` doc -- The seq is useful for poking on black holes
+    else info `seq` doc -- The seq is useful for poking on black holes
   where
     prag_info = inlinePragInfo info
     occ_info  = occInfo info