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