{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE BinaryLiterals #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module GHC.Types.Id.Info (
IdDetails(..), pprIdDetails, coVarDetails, isCoVarDetails,
JoinArity, isJoinIdDetails_maybe,
RecSelParent(..),
IdInfo,
vanillaIdInfo, noCafIdInfo,
OneShotInfo(..),
oneShotInfo, noOneShotInfo, hasNoOneShotInfo,
setOneShotInfo,
zapLamInfo, zapFragileInfo,
zapDemandInfo, zapUsageInfo, zapUsageEnvInfo, zapUsedOnceInfo,
zapTailCallInfo, zapCallArityInfo, trimUnfolding,
ArityInfo,
unknownArity,
arityInfo, setArityInfo, ppArityInfo,
callArityInfo, setCallArityInfo,
dmdSigInfo, setDmdSigInfo,
cprSigInfo, setCprSigInfo,
demandInfo, setDemandInfo, pprStrictness,
realUnfoldingInfo, unfoldingInfo, setUnfoldingInfo, hasInlineUnfolding,
InlinePragInfo,
inlinePragInfo, setInlinePragInfo,
OccInfo(..),
isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker,
occInfo, setOccInfo,
InsideLam(..), BranchCount,
TailCallInfo(..),
tailCallInfo, isAlwaysTailCalled,
RuleInfo(..),
emptyRuleInfo,
isEmptyRuleInfo, ruleInfoFreeVars,
ruleInfoRules, setRuleInfoHead,
ruleInfo, setRuleInfo, tagSigInfo,
CafInfo(..),
ppCafInfo, mayHaveCafRefs,
cafInfo, setCafInfo,
LambdaFormInfo,
lfInfo, setLFInfo, setTagSig,
tagSig,
TickBoxOp(..), TickBoxId,
) where
import GHC.Prelude
import GHC.Core
import GHC.Core.Class
import {-# SOURCE #-} GHC.Builtin.PrimOps (PrimOp)
import GHC.Types.Name
import GHC.Types.Var.Set
import GHC.Types.Basic
import GHC.Core.DataCon
import GHC.Core.TyCon
import GHC.Core.PatSyn
import GHC.Types.ForeignCall
import GHC.Unit.Module
import GHC.Types.Demand
import GHC.Types.Cpr
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Stg.InferTags.TagSig
import Data.Word
import GHC.StgToCmm.Types (LambdaFormInfo)
infixl 1 `setRuleInfo`,
`setArityInfo`,
`setInlinePragInfo`,
`setUnfoldingInfo`,
`setOneShotInfo`,
`setOccInfo`,
`setCafInfo`,
`setDmdSigInfo`,
`setCprSigInfo`,
`setDemandInfo`
data IdDetails
= VanillaId
| RecSelId
{ IdDetails -> RecSelParent
sel_tycon :: RecSelParent
, IdDetails -> Bool
sel_naughty :: Bool
}
| DataConWorkId DataCon
| DataConWrapId DataCon
| ClassOpId Class
| PrimOpId PrimOp Bool
| FCallId ForeignCall
| TickBoxOpId TickBoxOp
| DFunId Bool
| CoVarId
| JoinId JoinArity (Maybe [CbvMark])
| WorkerLikeId [CbvMark]
data RecSelParent = RecSelData TyCon | RecSelPatSyn PatSyn deriving RecSelParent -> RecSelParent -> Bool
(RecSelParent -> RecSelParent -> Bool)
-> (RecSelParent -> RecSelParent -> Bool) -> Eq RecSelParent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RecSelParent -> RecSelParent -> Bool
== :: RecSelParent -> RecSelParent -> Bool
$c/= :: RecSelParent -> RecSelParent -> Bool
/= :: RecSelParent -> RecSelParent -> Bool
Eq
instance Outputable RecSelParent where
ppr :: RecSelParent -> SDoc
ppr RecSelParent
p = case RecSelParent
p of
RecSelData TyCon
ty_con -> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
ty_con
RecSelPatSyn PatSyn
ps -> PatSyn -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatSyn
ps
coVarDetails :: IdDetails
coVarDetails :: IdDetails
coVarDetails = IdDetails
CoVarId
isCoVarDetails :: IdDetails -> Bool
isCoVarDetails :: IdDetails -> Bool
isCoVarDetails IdDetails
CoVarId = Bool
True
isCoVarDetails IdDetails
_ = Bool
False
isJoinIdDetails_maybe :: IdDetails -> Maybe (JoinArity, (Maybe [CbvMark]))
isJoinIdDetails_maybe :: IdDetails -> Maybe (Int, Maybe [CbvMark])
isJoinIdDetails_maybe (JoinId Int
join_arity Maybe [CbvMark]
marks) = (Int, Maybe [CbvMark]) -> Maybe (Int, Maybe [CbvMark])
forall a. a -> Maybe a
Just (Int
join_arity, Maybe [CbvMark]
marks)
isJoinIdDetails_maybe IdDetails
_ = Maybe (Int, Maybe [CbvMark])
forall a. Maybe a
Nothing
instance Outputable IdDetails where
ppr :: IdDetails -> SDoc
ppr = IdDetails -> SDoc
pprIdDetails
pprIdDetails :: IdDetails -> SDoc
pprIdDetails :: IdDetails -> SDoc
pprIdDetails IdDetails
VanillaId = SDoc
forall doc. IsOutput doc => doc
empty
pprIdDetails IdDetails
other = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (IdDetails -> SDoc
pp IdDetails
other)
where
pp :: IdDetails -> SDoc
pp IdDetails
VanillaId = String -> SDoc
forall a. HasCallStack => String -> a
panic String
"pprIdDetails"
pp (WorkerLikeId [CbvMark]
dmds) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"StrictWorker" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([CbvMark] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [CbvMark]
dmds)
pp (DataConWorkId DataCon
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"DataCon"
pp (DataConWrapId DataCon
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"DataConWrapper"
pp (ClassOpId {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ClassOp"
pp (PrimOpId {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PrimOp"
pp (FCallId ForeignCall
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ForeignCall"
pp (TickBoxOpId TickBoxOp
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TickBoxOp"
pp (DFunId Bool
nt) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"DFunId" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen Bool
nt (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(nt)")
pp (RecSelId { sel_naughty :: IdDetails -> Bool
sel_naughty = Bool
is_naughty })
= SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RecSel" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen Bool
is_naughty (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(naughty)")
pp IdDetails
CoVarId = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CoVarId"
pp (JoinId Int
arity Maybe [CbvMark]
marks) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"JoinId" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
arity) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (Maybe [CbvMark] -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe [CbvMark]
marks)
data IdInfo
= IdInfo {
IdInfo -> RuleInfo
ruleInfo :: RuleInfo,
IdInfo -> Unfolding
realUnfoldingInfo :: Unfolding,
IdInfo -> InlinePragma
inlinePragInfo :: InlinePragma,
IdInfo -> OccInfo
occInfo :: OccInfo,
IdInfo -> DmdSig
dmdSigInfo :: DmdSig,
IdInfo -> CprSig
cprSigInfo :: CprSig,
IdInfo -> Demand
demandInfo :: Demand,
IdInfo -> BitField
bitfield :: {-# UNPACK #-} !BitField,
IdInfo -> Maybe LambdaFormInfo
lfInfo :: !(Maybe LambdaFormInfo),
IdInfo -> Maybe TagSig
tagSig :: !(Maybe TagSig)
}
newtype BitField = BitField Word64
emptyBitField :: BitField
emptyBitField :: BitField
emptyBitField = Word64 -> BitField
BitField Word64
0
bitfieldGetOneShotInfo :: BitField -> OneShotInfo
bitfieldGetOneShotInfo :: BitField -> OneShotInfo
bitfieldGetOneShotInfo (BitField Word64
bits) =
if Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word64
bits Int
0 then OneShotInfo
OneShotLam else OneShotInfo
NoOneShotInfo
bitfieldGetCafInfo :: BitField -> CafInfo
bitfieldGetCafInfo :: BitField -> CafInfo
bitfieldGetCafInfo (BitField Word64
bits) =
if Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word64
bits Int
1 then CafInfo
NoCafRefs else CafInfo
MayHaveCafRefs
bitfieldGetCallArityInfo :: BitField -> ArityInfo
bitfieldGetCallArityInfo :: BitField -> Int
bitfieldGetCallArityInfo (BitField Word64
bits) =
Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
bits Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
3) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. ((Int
1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
30) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
bitfieldGetArityInfo :: BitField -> ArityInfo
bitfieldGetArityInfo :: BitField -> Int
bitfieldGetArityInfo (BitField Word64
bits) =
Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
bits Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
33)
bitfieldSetOneShotInfo :: OneShotInfo -> BitField -> BitField
bitfieldSetOneShotInfo :: OneShotInfo -> BitField -> BitField
bitfieldSetOneShotInfo OneShotInfo
info (BitField Word64
bits) =
case OneShotInfo
info of
OneShotInfo
NoOneShotInfo -> Word64 -> BitField
BitField (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
clearBit Word64
bits Int
0)
OneShotInfo
OneShotLam -> Word64 -> BitField
BitField (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
setBit Word64
bits Int
0)
bitfieldSetCafInfo :: CafInfo -> BitField -> BitField
bitfieldSetCafInfo :: CafInfo -> BitField -> BitField
bitfieldSetCafInfo CafInfo
info (BitField Word64
bits) =
case CafInfo
info of
CafInfo
MayHaveCafRefs -> Word64 -> BitField
BitField (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
clearBit Word64
bits Int
1)
CafInfo
NoCafRefs -> Word64 -> BitField
BitField (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
setBit Word64
bits Int
1)
bitfieldSetCallArityInfo :: ArityInfo -> BitField -> BitField
bitfieldSetCallArityInfo :: Int -> BitField -> BitField
bitfieldSetCallArityInfo Int
info bf :: BitField
bf@(BitField Word64
bits) =
Bool -> BitField -> BitField
forall a. HasCallStack => Bool -> a -> a
assert (Int
info Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
30 :: Int) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (BitField -> BitField) -> BitField -> BitField
forall a b. (a -> b) -> a -> b
$
Int -> BitField -> BitField
bitfieldSetArityInfo (BitField -> Int
bitfieldGetArityInfo BitField
bf) (BitField -> BitField) -> BitField -> BitField
forall a b. (a -> b) -> a -> b
$
Word64 -> BitField
BitField ((Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
info Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
3) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word64
bits Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0b111))
bitfieldSetArityInfo :: ArityInfo -> BitField -> BitField
bitfieldSetArityInfo :: Int -> BitField -> BitField
bitfieldSetArityInfo Int
info (BitField Word64
bits) =
Bool -> BitField -> BitField
forall a. HasCallStack => Bool -> a -> a
assert (Int
info Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
30 :: Int) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (BitField -> BitField) -> BitField -> BitField
forall a b. (a -> b) -> a -> b
$
Word64 -> BitField
BitField ((Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
info Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
33) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word64
bits Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. ((Word64
1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
33) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)))
oneShotInfo :: IdInfo -> OneShotInfo
oneShotInfo :: IdInfo -> OneShotInfo
oneShotInfo = BitField -> OneShotInfo
bitfieldGetOneShotInfo (BitField -> OneShotInfo)
-> (IdInfo -> BitField) -> IdInfo -> OneShotInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdInfo -> BitField
bitfield
arityInfo :: IdInfo -> ArityInfo
arityInfo :: IdInfo -> Int
arityInfo = BitField -> Int
bitfieldGetArityInfo (BitField -> Int) -> (IdInfo -> BitField) -> IdInfo -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdInfo -> BitField
bitfield
cafInfo :: IdInfo -> CafInfo
cafInfo :: IdInfo -> CafInfo
cafInfo = BitField -> CafInfo
bitfieldGetCafInfo (BitField -> CafInfo) -> (IdInfo -> BitField) -> IdInfo -> CafInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdInfo -> BitField
bitfield
callArityInfo :: IdInfo -> ArityInfo
callArityInfo :: IdInfo -> Int
callArityInfo = BitField -> Int
bitfieldGetCallArityInfo (BitField -> Int) -> (IdInfo -> BitField) -> IdInfo -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdInfo -> BitField
bitfield
tagSigInfo :: IdInfo -> Maybe TagSig
tagSigInfo :: IdInfo -> Maybe TagSig
tagSigInfo = IdInfo -> Maybe TagSig
tagSig
setRuleInfo :: IdInfo -> RuleInfo -> IdInfo
setRuleInfo :: IdInfo -> RuleInfo -> IdInfo
setRuleInfo IdInfo
info RuleInfo
sp = RuleInfo
sp RuleInfo -> IdInfo -> IdInfo
forall a b. a -> b -> b
`seq` IdInfo
info { ruleInfo = sp }
setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo
setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo
setInlinePragInfo IdInfo
info InlinePragma
pr = InlinePragma
pr InlinePragma -> IdInfo -> IdInfo
forall a b. a -> b -> b
`seq` IdInfo
info { inlinePragInfo = pr }
setOccInfo :: IdInfo -> OccInfo -> IdInfo
setOccInfo :: IdInfo -> OccInfo -> IdInfo
setOccInfo IdInfo
info OccInfo
oc = OccInfo
oc OccInfo -> IdInfo -> IdInfo
forall a b. a -> b -> b
`seq` IdInfo
info { occInfo = oc }
unfoldingInfo :: IdInfo -> Unfolding
unfoldingInfo :: IdInfo -> Unfolding
unfoldingInfo IdInfo
info
| OccInfo -> Bool
isStrongLoopBreaker (IdInfo -> OccInfo
occInfo IdInfo
info) = Unfolding -> Unfolding
trimUnfolding (Unfolding -> Unfolding) -> Unfolding -> Unfolding
forall a b. (a -> b) -> a -> b
$ IdInfo -> Unfolding
realUnfoldingInfo IdInfo
info
| Bool
otherwise = IdInfo -> Unfolding
realUnfoldingInfo IdInfo
info
setUnfoldingInfo :: IdInfo -> Unfolding -> IdInfo
setUnfoldingInfo :: IdInfo -> Unfolding -> IdInfo
setUnfoldingInfo IdInfo
info Unfolding
uf
=
IdInfo
info { realUnfoldingInfo = uf }
hasInlineUnfolding :: IdInfo -> Bool
hasInlineUnfolding :: IdInfo -> Bool
hasInlineUnfolding IdInfo
info = Unfolding -> Bool
isInlineUnfolding (IdInfo -> Unfolding
unfoldingInfo IdInfo
info)
setArityInfo :: IdInfo -> ArityInfo -> IdInfo
setArityInfo :: IdInfo -> Int -> IdInfo
setArityInfo IdInfo
info Int
ar =
IdInfo
info { bitfield = bitfieldSetArityInfo ar (bitfield info) }
setCallArityInfo :: IdInfo -> ArityInfo -> IdInfo
setCallArityInfo :: IdInfo -> Int -> IdInfo
setCallArityInfo IdInfo
info Int
ar =
IdInfo
info { bitfield = bitfieldSetCallArityInfo ar (bitfield info) }
setCafInfo :: IdInfo -> CafInfo -> IdInfo
setCafInfo :: IdInfo -> CafInfo -> IdInfo
setCafInfo IdInfo
info CafInfo
caf =
IdInfo
info { bitfield = bitfieldSetCafInfo caf (bitfield info) }
setLFInfo :: IdInfo -> LambdaFormInfo -> IdInfo
setLFInfo :: IdInfo -> LambdaFormInfo -> IdInfo
setLFInfo IdInfo
info LambdaFormInfo
lf = IdInfo
info { lfInfo = Just lf }
setTagSig :: IdInfo -> TagSig -> IdInfo
setTagSig :: IdInfo -> TagSig -> IdInfo
setTagSig IdInfo
info TagSig
sig = IdInfo
info { tagSig = Just sig }
setOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo
setOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo
setOneShotInfo IdInfo
info OneShotInfo
lb =
IdInfo
info { bitfield = bitfieldSetOneShotInfo lb (bitfield info) }
setDemandInfo :: IdInfo -> Demand -> IdInfo
setDemandInfo :: IdInfo -> Demand -> IdInfo
setDemandInfo IdInfo
info Demand
dd = Demand
dd Demand -> IdInfo -> IdInfo
forall a b. a -> b -> b
`seq` IdInfo
info { demandInfo = dd }
setDmdSigInfo :: IdInfo -> DmdSig -> IdInfo
setDmdSigInfo :: IdInfo -> DmdSig -> IdInfo
setDmdSigInfo IdInfo
info DmdSig
dd = DmdSig
dd DmdSig -> IdInfo -> IdInfo
forall a b. a -> b -> b
`seq` IdInfo
info { dmdSigInfo = dd }
setCprSigInfo :: IdInfo -> CprSig -> IdInfo
setCprSigInfo :: IdInfo -> CprSig -> IdInfo
setCprSigInfo IdInfo
info CprSig
cpr = CprSig
cpr CprSig -> IdInfo -> IdInfo
forall a b. a -> b -> b
`seq` IdInfo
info { cprSigInfo = cpr }
vanillaIdInfo :: IdInfo
vanillaIdInfo :: IdInfo
vanillaIdInfo
= IdInfo {
ruleInfo :: RuleInfo
ruleInfo = RuleInfo
emptyRuleInfo,
realUnfoldingInfo :: Unfolding
realUnfoldingInfo = Unfolding
noUnfolding,
inlinePragInfo :: InlinePragma
inlinePragInfo = InlinePragma
defaultInlinePragma,
occInfo :: OccInfo
occInfo = OccInfo
noOccInfo,
demandInfo :: Demand
demandInfo = Demand
topDmd,
dmdSigInfo :: DmdSig
dmdSigInfo = DmdSig
nopSig,
cprSigInfo :: CprSig
cprSigInfo = CprSig
topCprSig,
bitfield :: BitField
bitfield = CafInfo -> BitField -> BitField
bitfieldSetCafInfo CafInfo
vanillaCafInfo (BitField -> BitField) -> BitField -> BitField
forall a b. (a -> b) -> a -> b
$
Int -> BitField -> BitField
bitfieldSetArityInfo Int
unknownArity (BitField -> BitField) -> BitField -> BitField
forall a b. (a -> b) -> a -> b
$
Int -> BitField -> BitField
bitfieldSetCallArityInfo Int
unknownArity (BitField -> BitField) -> BitField -> BitField
forall a b. (a -> b) -> a -> b
$
OneShotInfo -> BitField -> BitField
bitfieldSetOneShotInfo OneShotInfo
NoOneShotInfo (BitField -> BitField) -> BitField -> BitField
forall a b. (a -> b) -> a -> b
$
BitField
emptyBitField,
lfInfo :: Maybe LambdaFormInfo
lfInfo = Maybe LambdaFormInfo
forall a. Maybe a
Nothing,
tagSig :: Maybe TagSig
tagSig = Maybe TagSig
forall a. Maybe a
Nothing
}
noCafIdInfo :: IdInfo
noCafIdInfo :: IdInfo
noCafIdInfo = IdInfo
vanillaIdInfo IdInfo -> CafInfo -> IdInfo
`setCafInfo` CafInfo
NoCafRefs
type ArityInfo = Arity
unknownArity :: Arity
unknownArity :: Int
unknownArity = Int
0
ppArityInfo :: Int -> SDoc
ppArityInfo :: Int -> SDoc
ppArityInfo Int
0 = SDoc
forall doc. IsOutput doc => doc
empty
ppArityInfo Int
n = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Arity", Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
n]
type InlinePragInfo = InlinePragma
pprStrictness :: DmdSig -> SDoc
pprStrictness :: DmdSig -> SDoc
pprStrictness DmdSig
sig = DmdSig -> SDoc
forall a. Outputable a => a -> SDoc
ppr DmdSig
sig
data RuleInfo
= RuleInfo
[CoreRule]
DVarSet
emptyRuleInfo :: RuleInfo
emptyRuleInfo :: RuleInfo
emptyRuleInfo = [CoreRule] -> DVarSet -> RuleInfo
RuleInfo [] DVarSet
emptyDVarSet
isEmptyRuleInfo :: RuleInfo -> Bool
isEmptyRuleInfo :: RuleInfo -> Bool
isEmptyRuleInfo (RuleInfo [CoreRule]
rs DVarSet
_) = [CoreRule] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CoreRule]
rs
ruleInfoFreeVars :: RuleInfo -> DVarSet
ruleInfoFreeVars :: RuleInfo -> DVarSet
ruleInfoFreeVars (RuleInfo [CoreRule]
_ DVarSet
fvs) = DVarSet
fvs
ruleInfoRules :: RuleInfo -> [CoreRule]
ruleInfoRules :: RuleInfo -> [CoreRule]
ruleInfoRules (RuleInfo [CoreRule]
rules DVarSet
_) = [CoreRule]
rules
setRuleInfoHead :: Name -> RuleInfo -> RuleInfo
setRuleInfoHead :: Name -> RuleInfo -> RuleInfo
setRuleInfoHead Name
fn (RuleInfo [CoreRule]
rules DVarSet
fvs)
= [CoreRule] -> DVarSet -> RuleInfo
RuleInfo ((CoreRule -> CoreRule) -> [CoreRule] -> [CoreRule]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> CoreRule -> CoreRule
setRuleIdName Name
fn) [CoreRule]
rules) DVarSet
fvs
data CafInfo
= MayHaveCafRefs
| NoCafRefs
deriving (CafInfo -> CafInfo -> Bool
(CafInfo -> CafInfo -> Bool)
-> (CafInfo -> CafInfo -> Bool) -> Eq CafInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CafInfo -> CafInfo -> Bool
== :: CafInfo -> CafInfo -> Bool
$c/= :: CafInfo -> CafInfo -> Bool
/= :: CafInfo -> CafInfo -> Bool
Eq, Eq CafInfo
Eq CafInfo =>
(CafInfo -> CafInfo -> Ordering)
-> (CafInfo -> CafInfo -> Bool)
-> (CafInfo -> CafInfo -> Bool)
-> (CafInfo -> CafInfo -> Bool)
-> (CafInfo -> CafInfo -> Bool)
-> (CafInfo -> CafInfo -> CafInfo)
-> (CafInfo -> CafInfo -> CafInfo)
-> Ord CafInfo
CafInfo -> CafInfo -> Bool
CafInfo -> CafInfo -> Ordering
CafInfo -> CafInfo -> CafInfo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CafInfo -> CafInfo -> Ordering
compare :: CafInfo -> CafInfo -> Ordering
$c< :: CafInfo -> CafInfo -> Bool
< :: CafInfo -> CafInfo -> Bool
$c<= :: CafInfo -> CafInfo -> Bool
<= :: CafInfo -> CafInfo -> Bool
$c> :: CafInfo -> CafInfo -> Bool
> :: CafInfo -> CafInfo -> Bool
$c>= :: CafInfo -> CafInfo -> Bool
>= :: CafInfo -> CafInfo -> Bool
$cmax :: CafInfo -> CafInfo -> CafInfo
max :: CafInfo -> CafInfo -> CafInfo
$cmin :: CafInfo -> CafInfo -> CafInfo
min :: CafInfo -> CafInfo -> CafInfo
Ord)
vanillaCafInfo :: CafInfo
vanillaCafInfo :: CafInfo
vanillaCafInfo = CafInfo
MayHaveCafRefs
mayHaveCafRefs :: CafInfo -> Bool
mayHaveCafRefs :: CafInfo -> Bool
mayHaveCafRefs CafInfo
MayHaveCafRefs = Bool
True
mayHaveCafRefs CafInfo
_ = Bool
False
instance Outputable CafInfo where
ppr :: CafInfo -> SDoc
ppr = CafInfo -> SDoc
ppCafInfo
ppCafInfo :: CafInfo -> SDoc
ppCafInfo :: CafInfo -> SDoc
ppCafInfo CafInfo
NoCafRefs = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NoCafRefs"
ppCafInfo CafInfo
MayHaveCafRefs = SDoc
forall doc. IsOutput doc => doc
empty
zapLamInfo :: IdInfo -> Maybe IdInfo
zapLamInfo :: IdInfo -> Maybe IdInfo
zapLamInfo info :: IdInfo
info@(IdInfo {occInfo :: IdInfo -> OccInfo
occInfo = OccInfo
occ, demandInfo :: IdInfo -> Demand
demandInfo = Demand
demand})
| OccInfo -> Bool
is_safe_occ OccInfo
occ Bool -> Bool -> Bool
&& Demand -> Bool
is_safe_dmd Demand
demand
= Maybe IdInfo
forall a. Maybe a
Nothing
| Bool
otherwise
= IdInfo -> Maybe IdInfo
forall a. a -> Maybe a
Just (IdInfo
info {occInfo = safe_occ, demandInfo = topDmd})
where
is_safe_occ :: OccInfo -> Bool
is_safe_occ OccInfo
occ | OccInfo -> Bool
isAlwaysTailCalled OccInfo
occ = Bool
False
is_safe_occ (OneOcc { occ_in_lam :: OccInfo -> InsideLam
occ_in_lam = InsideLam
NotInsideLam }) = Bool
False
is_safe_occ OccInfo
_other = Bool
True
safe_occ :: OccInfo
safe_occ = case OccInfo
occ of
OneOcc{} -> OccInfo
occ { occ_in_lam = IsInsideLam
, occ_tail = NoTailCallInfo }
IAmALoopBreaker{}
-> OccInfo
occ { occ_tail = NoTailCallInfo }
OccInfo
_other -> OccInfo
occ
is_safe_dmd :: Demand -> Bool
is_safe_dmd Demand
dmd = Bool -> Bool
not (Demand -> Bool
isStrUsedDmd Demand
dmd)
zapDemandInfo :: IdInfo -> Maybe IdInfo
zapDemandInfo :: IdInfo -> Maybe IdInfo
zapDemandInfo IdInfo
info = IdInfo -> Maybe IdInfo
forall a. a -> Maybe a
Just (IdInfo
info {demandInfo = topDmd})
zapUsageInfo :: IdInfo -> Maybe IdInfo
zapUsageInfo :: IdInfo -> Maybe IdInfo
zapUsageInfo IdInfo
info = IdInfo -> Maybe IdInfo
forall a. a -> Maybe a
Just (IdInfo
info {demandInfo = zapUsageDemand (demandInfo info)})
zapUsageEnvInfo :: IdInfo -> Maybe IdInfo
zapUsageEnvInfo :: IdInfo -> Maybe IdInfo
zapUsageEnvInfo IdInfo
info
| DmdSig -> Bool
hasDemandEnvSig (IdInfo -> DmdSig
dmdSigInfo IdInfo
info)
= IdInfo -> Maybe IdInfo
forall a. a -> Maybe a
Just (IdInfo
info {dmdSigInfo = zapDmdEnvSig (dmdSigInfo info)})
| Bool
otherwise
= Maybe IdInfo
forall a. Maybe a
Nothing
zapUsedOnceInfo :: IdInfo -> Maybe IdInfo
zapUsedOnceInfo :: IdInfo -> Maybe IdInfo
zapUsedOnceInfo IdInfo
info
= IdInfo -> Maybe IdInfo
forall a. a -> Maybe a
Just (IdInfo -> Maybe IdInfo) -> IdInfo -> Maybe IdInfo
forall a b. (a -> b) -> a -> b
$ IdInfo
info { dmdSigInfo = zapUsedOnceSig (dmdSigInfo info)
, demandInfo = zapUsedOnceDemand (demandInfo info) }
zapFragileInfo :: IdInfo -> Maybe IdInfo
zapFragileInfo :: IdInfo -> Maybe IdInfo
zapFragileInfo info :: IdInfo
info@(IdInfo { occInfo :: IdInfo -> OccInfo
occInfo = OccInfo
occ, realUnfoldingInfo :: IdInfo -> Unfolding
realUnfoldingInfo = Unfolding
unf })
= Unfolding
new_unf Unfolding -> Maybe IdInfo -> Maybe IdInfo
forall a b. a -> b -> b
`seq`
IdInfo -> Maybe IdInfo
forall a. a -> Maybe a
Just (IdInfo
info IdInfo -> RuleInfo -> IdInfo
`setRuleInfo` RuleInfo
emptyRuleInfo
IdInfo -> Unfolding -> IdInfo
`setUnfoldingInfo` Unfolding
new_unf
IdInfo -> OccInfo -> IdInfo
`setOccInfo` OccInfo -> OccInfo
zapFragileOcc OccInfo
occ)
where
new_unf :: Unfolding
new_unf = Unfolding -> Unfolding
zapFragileUnfolding Unfolding
unf
zapFragileUnfolding :: Unfolding -> Unfolding
zapFragileUnfolding :: Unfolding -> Unfolding
zapFragileUnfolding Unfolding
unf
| Unfolding -> Bool
isEvaldUnfolding Unfolding
unf = Unfolding
evaldUnfolding
| Bool
otherwise = Unfolding
noUnfolding
trimUnfolding :: Unfolding -> Unfolding
trimUnfolding :: Unfolding -> Unfolding
trimUnfolding Unfolding
unf | Unfolding -> Bool
isEvaldUnfolding Unfolding
unf = Unfolding
evaldUnfolding
| Bool
otherwise = Unfolding
noUnfolding
zapTailCallInfo :: IdInfo -> Maybe IdInfo
zapTailCallInfo :: IdInfo -> Maybe IdInfo
zapTailCallInfo IdInfo
info
= case IdInfo -> OccInfo
occInfo IdInfo
info of
OccInfo
occ | OccInfo -> Bool
isAlwaysTailCalled OccInfo
occ -> IdInfo -> Maybe IdInfo
forall a. a -> Maybe a
Just (IdInfo
info IdInfo -> OccInfo -> IdInfo
`setOccInfo` OccInfo
safe_occ)
| Bool
otherwise -> Maybe IdInfo
forall a. Maybe a
Nothing
where
safe_occ :: OccInfo
safe_occ = OccInfo
occ { occ_tail = NoTailCallInfo }
zapCallArityInfo :: IdInfo -> IdInfo
zapCallArityInfo :: IdInfo -> IdInfo
zapCallArityInfo IdInfo
info = IdInfo -> Int -> IdInfo
setCallArityInfo IdInfo
info Int
0
type TickBoxId = Int
data TickBoxOp
= TickBox Module {-# UNPACK #-} !TickBoxId
instance Outputable TickBoxOp where
ppr :: TickBoxOp -> SDoc
ppr (TickBox Module
mod Int
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"tick" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (Module, Int) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module
mod,Int
n)