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