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
7module GHC.Core.Seq (
8        -- * Utilities for forcing Core structures
9        seqExpr, seqExprs, seqUnfolding, seqRules,
10        megaSeqIdInfo, seqRuleInfo, seqBinds,
11    ) where
12
13import GHC.Prelude
14
15import GHC.Core
16import GHC.Types.Id.Info
17import GHC.Types.Demand( seqDemand, seqStrictSig )
18import GHC.Types.Cpr( seqCprSig )
19import GHC.Types.Basic( seqOccInfo )
20import GHC.Types.Tickish
21import GHC.Types.Var.Set( seqDVarSet )
22import GHC.Types.Var( varType, tyVarKind )
23import GHC.Core.Type( seqType, isTyVar )
24import GHC.Core.Coercion( seqCo )
25import GHC.Types.Id( idInfo )
26
27-- | Evaluate all the fields of the 'IdInfo' that are generally demanded by the
28-- compiler
29megaSeqIdInfo :: IdInfo -> ()
30megaSeqIdInfo 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 (unfoldingInfo info)         `seq`
36
37    seqDemand (demandInfo info)                 `seq`
38    seqStrictSig (strictnessInfo info)          `seq`
39    seqCprSig (cprInfo info)                    `seq`
40    seqCaf (cafInfo info)                       `seq`
41    seqOneShot (oneShotInfo info)               `seq`
42    seqOccInfo (occInfo info)
43
44seqOneShot :: OneShotInfo -> ()
45seqOneShot l = l `seq` ()
46
47seqRuleInfo :: RuleInfo -> ()
48seqRuleInfo (RuleInfo rules fvs) = seqRules rules `seq` seqDVarSet fvs
49
50seqCaf :: CafInfo -> ()
51seqCaf c = c `seq` ()
52
53seqRules :: [CoreRule] -> ()
54seqRules [] = ()
55seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
56  = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
57seqRules (BuiltinRule {} : rules) = seqRules rules
58
59seqExpr :: CoreExpr -> ()
60seqExpr (Var v)         = v `seq` ()
61seqExpr (Lit lit)       = lit `seq` ()
62seqExpr (App f a)       = seqExpr f `seq` seqExpr a
63seqExpr (Lam b e)       = seqBndr b `seq` seqExpr e
64seqExpr (Let b e)       = seqBind b `seq` seqExpr e
65seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
66seqExpr (Cast e co)     = seqExpr e `seq` seqCo co
67seqExpr (Tick n e)      = seqTickish n `seq` seqExpr e
68seqExpr (Type t)        = seqType t
69seqExpr (Coercion co)   = seqCo co
70
71seqExprs :: [CoreExpr] -> ()
72seqExprs [] = ()
73seqExprs (e:es) = seqExpr e `seq` seqExprs es
74
75seqTickish :: CoreTickish -> ()
76seqTickish ProfNote{ profNoteCC = cc } = cc `seq` ()
77seqTickish HpcTick{} = ()
78seqTickish Breakpoint{ breakpointFVs = ids } = seqBndrs ids
79seqTickish SourceNote{} = ()
80
81seqBndr :: CoreBndr -> ()
82seqBndr b | isTyVar b = seqType (tyVarKind b)
83          | otherwise = seqType (varType b)             `seq`
84                        megaSeqIdInfo (idInfo b)
85
86seqBndrs :: [CoreBndr] -> ()
87seqBndrs [] = ()
88seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
89
90seqBinds :: [Bind CoreBndr] -> ()
91seqBinds bs = foldr (seq . seqBind) () bs
92
93seqBind :: Bind CoreBndr -> ()
94seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
95seqBind (Rec prs)    = seqPairs prs
96
97seqPairs :: [(CoreBndr, CoreExpr)] -> ()
98seqPairs [] = ()
99seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
100
101seqAlts :: [CoreAlt] -> ()
102seqAlts [] = ()
103seqAlts (Alt c bs e:alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
104
105seqUnfolding :: Unfolding -> ()
106seqUnfolding (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
112seqUnfolding _ = ()
113
114seqGuidance :: UnfoldingGuidance -> ()
115seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
116seqGuidance _                      = ()
117