-- |
-- 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 GHC.Core.Seq (
        -- * Utilities for forcing Core structures
        seqExpr, seqExprs, seqUnfolding, seqRules,
        megaSeqIdInfo, seqRuleInfo, seqBinds,
    ) where

import GHC.Prelude

import GHC.Core
import GHC.Types.Id.Info
import GHC.Types.Demand( seqDemand, seqDmdSig )
import GHC.Types.Cpr( seqCprSig )
import GHC.Types.Basic( seqOccInfo )
import GHC.Types.Tickish
import GHC.Types.Var.Set( seqDVarSet )
import GHC.Types.Var( varType, tyVarKind )
import GHC.Core.Type( seqType, isTyVar )
import GHC.Core.Coercion( seqCo )
import GHC.Types.Id( idInfo )

-- | Evaluate all the fields of the 'IdInfo' that are generally demanded by the
-- compiler
megaSeqIdInfo :: IdInfo -> ()
megaSeqIdInfo :: IdInfo -> ()
megaSeqIdInfo 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 (realUnfoldingInfo info)         `seq`

    Demand -> ()
seqDemand (IdInfo -> Demand
demandInfo IdInfo
info)                 () -> () -> ()
forall a b. a -> b -> b
`seq`
    DmdSig -> ()
seqDmdSig (IdInfo -> DmdSig
dmdSigInfo IdInfo
info)          () -> () -> ()
forall a b. a -> b -> b
`seq`
    CprSig -> ()
seqCprSig (IdInfo -> CprSig
cprSigInfo 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 OneShotInfo
l = OneShotInfo
l OneShotInfo -> () -> ()
forall a b. a -> b -> b
`seq` ()

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

seqCaf :: CafInfo -> ()
seqCaf :: CafInfo -> ()
seqCaf 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 } : [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 {} : [CoreRule]
rules) = [CoreRule] -> ()
seqRules [CoreRule]
rules

seqExpr :: CoreExpr -> ()
seqExpr :: CoreExpr -> ()
seqExpr (Var CoreBndr
v)         = CoreBndr
v CoreBndr -> () -> ()
forall a b. a -> b -> b
`seq` ()
seqExpr (Lit Literal
lit)       = Literal
lit Literal -> () -> ()
forall a b. a -> b -> b
`seq` ()
seqExpr (App CoreExpr
f CoreExpr
a)       = CoreExpr -> ()
seqExpr CoreExpr
f () -> () -> ()
forall a b. a -> b -> b
`seq` CoreExpr -> ()
seqExpr CoreExpr
a
seqExpr (Lam CoreBndr
b CoreExpr
e)       = CoreBndr -> ()
seqBndr CoreBndr
b () -> () -> ()
forall a b. a -> b -> b
`seq` CoreExpr -> ()
seqExpr CoreExpr
e
seqExpr (Let Bind CoreBndr
b CoreExpr
e)       = Bind CoreBndr -> ()
seqBind Bind CoreBndr
b () -> () -> ()
forall a b. a -> b -> b
`seq` CoreExpr -> ()
seqExpr CoreExpr
e
seqExpr (Case CoreExpr
e CoreBndr
b Type
t [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 CoreExpr
e CoercionR
co)     = CoreExpr -> ()
seqExpr CoreExpr
e () -> () -> ()
forall a b. a -> b -> b
`seq` CoercionR -> ()
seqCo CoercionR
co
seqExpr (Tick CoreTickish
n CoreExpr
e)      = CoreTickish -> ()
seqTickish CoreTickish
n () -> () -> ()
forall a b. a -> b -> b
`seq` CoreExpr -> ()
seqExpr CoreExpr
e
seqExpr (Type Type
t)        = Type -> ()
seqType Type
t
seqExpr (Coercion CoercionR
co)   = CoercionR -> ()
seqCo CoercionR
co

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

seqTickish :: CoreTickish -> ()
seqTickish :: CoreTickish -> ()
seqTickish ProfNote{ profNoteCC :: forall (pass :: TickishPass). GenTickish pass -> CostCentre
profNoteCC = CostCentre
cc } = CostCentre
cc CostCentre -> () -> ()
forall a b. a -> b -> b
`seq` ()
seqTickish HpcTick{} = ()
seqTickish Breakpoint{ breakpointFVs :: forall (pass :: TickishPass). GenTickish pass -> [XTickishId pass]
breakpointFVs = [XTickishId 'TickishPassCore]
ids } = [CoreBndr] -> ()
seqBndrs [CoreBndr]
[XTickishId 'TickishPassCore]
ids
seqTickish SourceNote{} = ()

seqBndr :: CoreBndr -> ()
seqBndr :: CoreBndr -> ()
seqBndr 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 ((() :: Constraint) => CoreBndr -> IdInfo
CoreBndr -> IdInfo
idInfo CoreBndr
b)

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

seqBinds :: [Bind CoreBndr] -> ()
seqBinds :: [Bind CoreBndr] -> ()
seqBinds [Bind CoreBndr]
bs = (Bind CoreBndr -> () -> ()) -> () -> [Bind CoreBndr] -> ()
forall a b. (a -> b -> b) -> b -> [a] -> b
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 CoreBndr
b CoreExpr
e) = CoreBndr -> ()
seqBndr CoreBndr
b () -> () -> ()
forall a b. a -> b -> b
`seq` CoreExpr -> ()
seqExpr CoreExpr
e
seqBind (Rec [(CoreBndr, CoreExpr)]
prs)    = [(CoreBndr, CoreExpr)] -> ()
seqPairs [(CoreBndr, CoreExpr)]
prs

seqPairs :: [(CoreBndr, CoreExpr)] -> ()
seqPairs :: [(CoreBndr, CoreExpr)] -> ()
seqPairs [] = ()
seqPairs ((CoreBndr
b,CoreExpr
e):[(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 (Alt AltCon
c [CoreBndr]
bs CoreExpr
e:[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 Unfolding
_ = ()

seqGuidance :: UnfoldingGuidance -> ()
seqGuidance :: UnfoldingGuidance -> ()
seqGuidance (UnfIfGoodArgs [Int]
ns Int
n Int
b) = Int
n Int -> () -> ()
forall a b. a -> b -> b
`seq` [Int] -> Int
forall a. Num a => [a] -> a
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 UnfoldingGuidance
_                      = ()