CoreUtils: Move seq* functions to CoreSeq
authorBen Gamari <ben@smart-cactus.org>
Tue, 7 Jul 2015 18:25:50 +0000 (20:25 +0200)
committerBen Gamari <ben@smart-cactus.org>
Thu, 16 Jul 2015 21:12:19 +0000 (23:12 +0200)
These seem to sit near the top of the import graph and have been causing
import cycles.

compiler/coreSyn/CoreSeq.hs [new file with mode: 0644]
compiler/coreSyn/CoreSubst.hs
compiler/coreSyn/CoreUtils.hs
compiler/ghc.cabal.in
compiler/ghc.mk

diff --git a/compiler/coreSyn/CoreSeq.hs b/compiler/coreSyn/CoreSeq.hs
new file mode 100644 (file)
index 0000000..9bd3f45
--- /dev/null
@@ -0,0 +1,111 @@
+-- |
+-- Various utilities for forcing Core structures
+--
+-- It can often be useful to force various parts of the AST. This module
+-- provides a number of @seq@-like functions to accomplish this.
+
+module CoreSeq (
+        -- * Utilities for forcing Core structures
+        seqExpr, seqExprs, seqUnfolding, seqRules,
+        megaSeqIdInfo, seqSpecInfo, seqBinds,
+    ) where
+
+import CoreSyn
+import IdInfo
+import Demand( seqDemand, seqStrictSig )
+import BasicTypes( seqOccInfo )
+import VarSet( seqVarSet )
+import Var( varType, tyVarKind )
+import Type( seqType, isTyVar )
+import Coercion( seqCo )
+import Id( Id, 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`
+
+    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` ()
+
+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
+
+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
+
+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 _                      = ()
index 4764b4d..e78ff70 100644 (file)
@@ -41,6 +41,7 @@ module CoreSubst (
 
 import CoreSyn
 import CoreFVs
+import CoreSeq
 import CoreUtils
 import Literal  ( Literal(MachStr) )
 import qualified Data.ByteString as BS
index d1cbcbc..1f35585 100644 (file)
@@ -40,10 +40,6 @@ module CoreUtils (
         -- * Eta reduction
         tryEtaReduce,
 
-        -- * Seq
-        seqExpr, seqExprs, seqUnfolding, seqRules,
-        seqIdInfo, megaSeqIdInfo, seqSpecInfo, seqBinds,
-
         -- * Manipulating data constructors and types
         applyTypeToArgs, applyTypeToArg,
         dataConRepInstPat, dataConRepFSInstPat,
@@ -67,8 +63,6 @@ import Name
 import Literal
 import DataCon
 import PrimOp
-import Demand( seqDemand, seqStrictSig )
-import BasicTypes( seqOccInfo )
 import Id
 import IdInfo
 import Type
@@ -1786,108 +1780,6 @@ 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}
 *                                                                      *
 ************************************************************************
index 38e92f8..941f219 100644 (file)
@@ -259,6 +259,7 @@ Library
         CoreTidy
         CoreUnfold
         CoreUtils
+        CoreSeq
         MkCore
         PprCore
         Check
index 0c02f49..0e47887 100644 (file)
@@ -490,6 +490,7 @@ compiler_stage2_dll0_MODULES = \
        CoreTidy \
        CoreUnfold \
        CoreUtils \
+       CoreSeq \
        CostCentre \
        Ctype \
        DataCon \