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 _                      = ()