never executed always true always false
1 -- |
2 -- Various utilities for forcing Core structures
3 --
4 -- It can often be useful to force various parts of the AST. This module
5 -- provides a number of @seq@-like functions to accomplish this.
6
7 module GHC.Core.Seq (
8 -- * Utilities for forcing Core structures
9 seqExpr, seqExprs, seqUnfolding, seqRules,
10 megaSeqIdInfo, seqRuleInfo, seqBinds,
11 ) where
12
13 import GHC.Prelude
14
15 import GHC.Core
16 import GHC.Types.Id.Info
17 import GHC.Types.Demand( seqDemand, seqDmdSig )
18 import GHC.Types.Cpr( seqCprSig )
19 import GHC.Types.Basic( seqOccInfo )
20 import GHC.Types.Tickish
21 import GHC.Types.Var.Set( seqDVarSet )
22 import GHC.Types.Var( varType, tyVarKind )
23 import GHC.Core.Type( seqType, isTyVar )
24 import GHC.Core.Coercion( seqCo )
25 import GHC.Types.Id( idInfo )
26
27 -- | Evaluate all the fields of the 'IdInfo' that are generally demanded by the
28 -- compiler
29 megaSeqIdInfo :: IdInfo -> ()
30 megaSeqIdInfo info
31 = seqRuleInfo (ruleInfo info) `seq`
32
33 -- Omitting this improves runtimes a little, presumably because
34 -- some unfoldings are not calculated at all
35 -- seqUnfolding (realUnfoldingInfo info) `seq`
36
37 seqDemand (demandInfo info) `seq`
38 seqDmdSig (dmdSigInfo info) `seq`
39 seqCprSig (cprSigInfo info) `seq`
40 seqCaf (cafInfo info) `seq`
41 seqOneShot (oneShotInfo info) `seq`
42 seqOccInfo (occInfo info)
43
44 seqOneShot :: OneShotInfo -> ()
45 seqOneShot l = l `seq` ()
46
47 seqRuleInfo :: RuleInfo -> ()
48 seqRuleInfo (RuleInfo rules fvs) = seqRules rules `seq` seqDVarSet fvs
49
50 seqCaf :: CafInfo -> ()
51 seqCaf c = c `seq` ()
52
53 seqRules :: [CoreRule] -> ()
54 seqRules [] = ()
55 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
56 = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
57 seqRules (BuiltinRule {} : rules) = seqRules rules
58
59 seqExpr :: CoreExpr -> ()
60 seqExpr (Var v) = v `seq` ()
61 seqExpr (Lit lit) = lit `seq` ()
62 seqExpr (App f a) = seqExpr f `seq` seqExpr a
63 seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
64 seqExpr (Let b e) = seqBind b `seq` seqExpr e
65 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
66 seqExpr (Cast e co) = seqExpr e `seq` seqCo co
67 seqExpr (Tick n e) = seqTickish n `seq` seqExpr e
68 seqExpr (Type t) = seqType t
69 seqExpr (Coercion co) = seqCo co
70
71 seqExprs :: [CoreExpr] -> ()
72 seqExprs [] = ()
73 seqExprs (e:es) = seqExpr e `seq` seqExprs es
74
75 seqTickish :: CoreTickish -> ()
76 seqTickish ProfNote{ profNoteCC = cc } = cc `seq` ()
77 seqTickish HpcTick{} = ()
78 seqTickish Breakpoint{ breakpointFVs = ids } = seqBndrs ids
79 seqTickish SourceNote{} = ()
80
81 seqBndr :: CoreBndr -> ()
82 seqBndr b | isTyVar b = seqType (tyVarKind b)
83 | otherwise = seqType (varType b) `seq`
84 megaSeqIdInfo (idInfo b)
85
86 seqBndrs :: [CoreBndr] -> ()
87 seqBndrs [] = ()
88 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
89
90 seqBinds :: [Bind CoreBndr] -> ()
91 seqBinds bs = foldr (seq . seqBind) () bs
92
93 seqBind :: Bind CoreBndr -> ()
94 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
95 seqBind (Rec prs) = seqPairs prs
96
97 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
98 seqPairs [] = ()
99 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
100
101 seqAlts :: [CoreAlt] -> ()
102 seqAlts [] = ()
103 seqAlts (Alt c bs e:alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
104
105 seqUnfolding :: Unfolding -> ()
106 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
107 uf_is_value = b1, uf_is_work_free = b2,
108 uf_expandable = b3, uf_is_conlike = b4,
109 uf_guidance = g})
110 = seqExpr e `seq` top `seq` b1 `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
111
112 seqUnfolding _ = ()
113
114 seqGuidance :: UnfoldingGuidance -> ()
115 seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
116 seqGuidance _ = ()