-- |
-- Various utilities for forcing Core structures
--
-- It can often be useful to force various parts of the AST. This module
-- provides a number of @seq@-like functions to accomplish this.

module CoreSeq (
        -- * Utilities for forcing Core structures
        seqExpr, seqExprs, seqUnfolding, seqRules,
        megaSeqIdInfo, seqRuleInfo, seqBinds,
    ) where

import GhcPrelude

import CoreSyn
import IdInfo
import Demand( seqDemand, seqStrictSig )
import BasicTypes( seqOccInfo )
import VarSet( seqDVarSet )
import Var( varType, tyVarKind )
import Type( seqType, isTyVar )
import Coercion( seqCo )
import Id( Id, idInfo )

-- | Evaluate all the fields of the 'IdInfo' that are generally demanded by the
-- compiler
megaSeqIdInfo :: IdInfo -> ()
megaSeqIdInfo :: IdInfo -> ()
megaSeqIdInfo info :: IdInfo
info
  = RuleInfo -> ()
seqRuleInfo (IdInfo -> RuleInfo
ruleInfo IdInfo
info)                 () -> () -> ()
forall a b. a -> b -> b
`seq`

-- Omitting this improves runtimes a little, presumably because
-- some unfoldings are not calculated at all
--    seqUnfolding (unfoldingInfo info)         `seq`

    Demand -> ()
seqDemand (IdInfo -> Demand
demandInfo IdInfo
info)                 () -> () -> ()
forall a b. a -> b -> b
`seq`
    StrictSig -> ()
seqStrictSig (IdInfo -> StrictSig
strictnessInfo IdInfo
info)          () -> () -> ()
forall a b. a -> b -> b
`seq`
    CafInfo -> ()
seqCaf (IdInfo -> CafInfo
cafInfo IdInfo
info)                       () -> () -> ()
forall a b. a -> b -> b
`seq`
    OneShotInfo -> ()
seqOneShot (IdInfo -> OneShotInfo
oneShotInfo IdInfo
info)               () -> () -> ()
forall a b. a -> b -> b
`seq`
    OccInfo -> ()
seqOccInfo (IdInfo -> OccInfo
occInfo IdInfo
info)

seqOneShot :: OneShotInfo -> ()
seqOneShot :: OneShotInfo -> ()
seqOneShot l :: OneShotInfo
l = OneShotInfo
l OneShotInfo -> () -> ()
forall a b. a -> b -> b
`seq` ()

seqRuleInfo :: RuleInfo -> ()
seqRuleInfo :: RuleInfo -> ()
seqRuleInfo (RuleInfo rules :: [CoreRule]
rules fvs :: DVarSet
fvs) = [CoreRule] -> ()
seqRules [CoreRule]
rules () -> () -> ()
forall a b. a -> b -> b
`seq` DVarSet -> ()
seqDVarSet DVarSet
fvs

seqCaf :: CafInfo -> ()
seqCaf :: CafInfo -> ()
seqCaf c :: CafInfo
c = CafInfo
c CafInfo -> () -> ()
forall a b. a -> b -> b
`seq` ()

seqRules :: [CoreRule] -> ()
seqRules :: [CoreRule] -> ()
seqRules [] = ()
seqRules (Rule { ru_bndrs :: CoreRule -> [CoreBndr]
ru_bndrs = [CoreBndr]
bndrs, ru_args :: CoreRule -> [CoreExpr]
ru_args = [CoreExpr]
args, ru_rhs :: CoreRule -> CoreExpr
ru_rhs = CoreExpr
rhs } : rules :: [CoreRule]
rules)
  = [CoreBndr] -> ()
seqBndrs [CoreBndr]
bndrs () -> () -> ()
forall a b. a -> b -> b
`seq` [CoreExpr] -> ()
seqExprs (CoreExpr
rhsCoreExpr -> [CoreExpr] -> [CoreExpr]
forall a. a -> [a] -> [a]
:[CoreExpr]
args) () -> () -> ()
forall a b. a -> b -> b
`seq` [CoreRule] -> ()
seqRules [CoreRule]
rules
seqRules (BuiltinRule {} : rules :: [CoreRule]
rules) = [CoreRule] -> ()
seqRules [CoreRule]
rules

seqExpr :: CoreExpr -> ()
seqExpr :: CoreExpr -> ()
seqExpr (Var v :: CoreBndr
v)         = CoreBndr
v CoreBndr -> () -> ()
forall a b. a -> b -> b
`seq` ()
seqExpr (Lit lit :: Literal
lit)       = Literal
lit Literal -> () -> ()
forall a b. a -> b -> b
`seq` ()
seqExpr (App f :: CoreExpr
f a :: CoreExpr
a)       = CoreExpr -> ()
seqExpr CoreExpr
f () -> () -> ()
forall a b. a -> b -> b
`seq` CoreExpr -> ()
seqExpr CoreExpr
a
seqExpr (Lam b :: CoreBndr
b e :: CoreExpr
e)       = CoreBndr -> ()
seqBndr CoreBndr
b () -> () -> ()
forall a b. a -> b -> b
`seq` CoreExpr -> ()
seqExpr CoreExpr
e
seqExpr (Let b :: Bind CoreBndr
b e :: CoreExpr
e)       = Bind CoreBndr -> ()
seqBind Bind CoreBndr
b () -> () -> ()
forall a b. a -> b -> b
`seq` CoreExpr -> ()
seqExpr CoreExpr
e
seqExpr (Case e :: CoreExpr
e b :: CoreBndr
b t :: Type
t as :: [Alt CoreBndr]
as) = CoreExpr -> ()
seqExpr CoreExpr
e () -> () -> ()
forall a b. a -> b -> b
`seq` CoreBndr -> ()
seqBndr CoreBndr
b () -> () -> ()
forall a b. a -> b -> b
`seq` Type -> ()
seqType Type
t () -> () -> ()
forall a b. a -> b -> b
`seq` [Alt CoreBndr] -> ()
seqAlts [Alt CoreBndr]
as
seqExpr (Cast e :: CoreExpr
e co :: Coercion
co)     = CoreExpr -> ()
seqExpr CoreExpr
e () -> () -> ()
forall a b. a -> b -> b
`seq` Coercion -> ()
seqCo Coercion
co
seqExpr (Tick n :: Tickish CoreBndr
n e :: CoreExpr
e)      = Tickish CoreBndr -> ()
seqTickish Tickish CoreBndr
n () -> () -> ()
forall a b. a -> b -> b
`seq` CoreExpr -> ()
seqExpr CoreExpr
e
seqExpr (Type t :: Type
t)        = Type -> ()
seqType Type
t
seqExpr (Coercion co :: Coercion
co)   = Coercion -> ()
seqCo Coercion
co

seqExprs :: [CoreExpr] -> ()
seqExprs :: [CoreExpr] -> ()
seqExprs [] = ()
seqExprs (e :: CoreExpr
e:es :: [CoreExpr]
es) = CoreExpr -> ()
seqExpr CoreExpr
e () -> () -> ()
forall a b. a -> b -> b
`seq` [CoreExpr] -> ()
seqExprs [CoreExpr]
es

seqTickish :: Tickish Id -> ()
seqTickish :: Tickish CoreBndr -> ()
seqTickish ProfNote{ profNoteCC :: forall id. Tickish id -> CostCentre
profNoteCC = CostCentre
cc } = CostCentre
cc CostCentre -> () -> ()
forall a b. a -> b -> b
`seq` ()
seqTickish HpcTick{} = ()
seqTickish Breakpoint{ breakpointFVs :: forall id. Tickish id -> [id]
breakpointFVs = [CoreBndr]
ids } = [CoreBndr] -> ()
seqBndrs [CoreBndr]
ids
seqTickish SourceNote{} = ()

seqBndr :: CoreBndr -> ()
seqBndr :: CoreBndr -> ()
seqBndr b :: CoreBndr
b | CoreBndr -> Bool
isTyVar CoreBndr
b = Type -> ()
seqType (CoreBndr -> Type
tyVarKind CoreBndr
b)
          | Bool
otherwise = Type -> ()
seqType (CoreBndr -> Type
varType CoreBndr
b)             () -> () -> ()
forall a b. a -> b -> b
`seq`
                        IdInfo -> ()
megaSeqIdInfo (HasDebugCallStack => CoreBndr -> IdInfo
CoreBndr -> IdInfo
idInfo CoreBndr
b)

seqBndrs :: [CoreBndr] -> ()
seqBndrs :: [CoreBndr] -> ()
seqBndrs [] = ()
seqBndrs (b :: CoreBndr
b:bs :: [CoreBndr]
bs) = CoreBndr -> ()
seqBndr CoreBndr
b () -> () -> ()
forall a b. a -> b -> b
`seq` [CoreBndr] -> ()
seqBndrs [CoreBndr]
bs

seqBinds :: [Bind CoreBndr] -> ()
seqBinds :: [Bind CoreBndr] -> ()
seqBinds bs :: [Bind CoreBndr]
bs = (Bind CoreBndr -> () -> ()) -> () -> [Bind CoreBndr] -> ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (() -> () -> ()
forall a b. a -> b -> b
seq (() -> () -> ())
-> (Bind CoreBndr -> ()) -> Bind CoreBndr -> () -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bind CoreBndr -> ()
seqBind) () [Bind CoreBndr]
bs

seqBind :: Bind CoreBndr -> ()
seqBind :: Bind CoreBndr -> ()
seqBind (NonRec b :: CoreBndr
b e :: CoreExpr
e) = CoreBndr -> ()
seqBndr CoreBndr
b () -> () -> ()
forall a b. a -> b -> b
`seq` CoreExpr -> ()
seqExpr CoreExpr
e
seqBind (Rec prs :: [(CoreBndr, CoreExpr)]
prs)    = [(CoreBndr, CoreExpr)] -> ()
seqPairs [(CoreBndr, CoreExpr)]
prs

seqPairs :: [(CoreBndr, CoreExpr)] -> ()
seqPairs :: [(CoreBndr, CoreExpr)] -> ()
seqPairs [] = ()
seqPairs ((b :: CoreBndr
b,e :: CoreExpr
e):prs :: [(CoreBndr, CoreExpr)]
prs) = CoreBndr -> ()
seqBndr CoreBndr
b () -> () -> ()
forall a b. a -> b -> b
`seq` CoreExpr -> ()
seqExpr CoreExpr
e () -> () -> ()
forall a b. a -> b -> b
`seq` [(CoreBndr, CoreExpr)] -> ()
seqPairs [(CoreBndr, CoreExpr)]
prs

seqAlts :: [CoreAlt] -> ()
seqAlts :: [Alt CoreBndr] -> ()
seqAlts [] = ()
seqAlts ((c :: AltCon
c,bs :: [CoreBndr]
bs,e :: CoreExpr
e):alts :: [Alt CoreBndr]
alts) = AltCon
c AltCon -> () -> ()
forall a b. a -> b -> b
`seq` [CoreBndr] -> ()
seqBndrs [CoreBndr]
bs () -> () -> ()
forall a b. a -> b -> b
`seq` CoreExpr -> ()
seqExpr CoreExpr
e () -> () -> ()
forall a b. a -> b -> b
`seq` [Alt CoreBndr] -> ()
seqAlts [Alt CoreBndr]
alts

seqUnfolding :: Unfolding -> ()
seqUnfolding :: Unfolding -> ()
seqUnfolding (CoreUnfolding { uf_tmpl :: Unfolding -> CoreExpr
uf_tmpl = CoreExpr
e, uf_is_top :: Unfolding -> Bool
uf_is_top = Bool
top,
                uf_is_value :: Unfolding -> Bool
uf_is_value = Bool
b1, uf_is_work_free :: Unfolding -> Bool
uf_is_work_free = Bool
b2,
                uf_expandable :: Unfolding -> Bool
uf_expandable = Bool
b3, uf_is_conlike :: Unfolding -> Bool
uf_is_conlike = Bool
b4,
                uf_guidance :: Unfolding -> UnfoldingGuidance
uf_guidance = UnfoldingGuidance
g})
  = CoreExpr -> ()
seqExpr CoreExpr
e () -> () -> ()
forall a b. a -> b -> b
`seq` Bool
top Bool -> () -> ()
forall a b. a -> b -> b
`seq` Bool
b1 Bool -> () -> ()
forall a b. a -> b -> b
`seq` Bool
b2 Bool -> () -> ()
forall a b. a -> b -> b
`seq` Bool
b3 Bool -> () -> ()
forall a b. a -> b -> b
`seq` Bool
b4 Bool -> () -> ()
forall a b. a -> b -> b
`seq` UnfoldingGuidance -> ()
seqGuidance UnfoldingGuidance
g

seqUnfolding _ = ()

seqGuidance :: UnfoldingGuidance -> ()
seqGuidance :: UnfoldingGuidance -> ()
seqGuidance (UnfIfGoodArgs ns :: [Int]
ns n :: Int
n b :: Int
b) = Int
n Int -> () -> ()
forall a b. a -> b -> b
`seq` [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
ns Int -> () -> ()
forall a b. a -> b -> b
`seq` Int
b Int -> () -> ()
forall a b. a -> b -> b
`seq` ()
seqGuidance _                      = ()