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