{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module GHC.Types.Id.Info (
IdDetails(..), pprIdDetails, coVarDetails, isCoVarDetails,
JoinArity, isJoinIdDetails_maybe,
RecSelParent(..), recSelParentName, recSelFirstConName,
recSelParentCons, idDetailsConcreteTvs,
RecSelInfo(..), conLikesRecSelInfo,
IdInfo,
vanillaIdInfo, noCafIdInfo,
OneShotInfo(..),
oneShotInfo, noOneShotInfo, hasNoOneShotInfo,
setOneShotInfo,
zapLamInfo, zapFragileInfo,
lazifyDemandInfo, floatifyDemandInfo,
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.Type (mkTyConApp)
import GHC.Core.PatSyn
import GHC.Core.ConLike
import GHC.Types.ForeignCall
import GHC.Unit.Module
import GHC.Types.Demand
import GHC.Types.Cpr
import {-# SOURCE #-} GHC.Tc.Utils.TcType ( ConcreteTyVars, noConcreteTyVars )
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Stg.EnforceEpt.TagSig
import GHC.StgToCmm.Types (LambdaFormInfo)
import Data.Data ( Data )
import Data.Word
import Data.List as List( partition )
infixl 1 `setRuleInfo`,
`setArityInfo`,
`setInlinePragInfo`,
`setUnfoldingInfo`,
`setOneShotInfo`,
`setOccInfo`,
`setCafInfo`,
`setDmdSigInfo`,
`setCprSigInfo`,
`setDemandInfo`,
`setLFInfo`
data IdDetails
= VanillaId
| RecSelId
{ IdDetails -> RecSelParent
sel_tycon :: RecSelParent
, IdDetails -> FieldLabel
sel_fieldLabel :: FieldLabel
, IdDetails -> Bool
sel_naughty :: Bool
, IdDetails -> RecSelInfo
sel_cons :: RecSelInfo
}
| DataConWorkId DataCon
| DataConWrapId DataCon
| ClassOpId
Class
Bool
| RepPolyId
{ IdDetails -> ConcreteTyVars
id_concrete_tvs :: ConcreteTyVars }
| PrimOpId
{ IdDetails -> PrimOp
id_primop :: PrimOp
, id_concrete_tvs :: ConcreteTyVars }
| FCallId ForeignCall
| TickBoxOpId TickBoxOp
| DFunId Bool
| CoVarId
| JoinId JoinArity (Maybe [CbvMark])
| WorkerLikeId [CbvMark]
data RecSelInfo
= RSI { RecSelInfo -> [ConLike]
rsi_def :: [ConLike]
, RecSelInfo -> [ConLike]
rsi_undef :: [ConLike]
}
idDetailsConcreteTvs :: IdDetails -> ConcreteTyVars
idDetailsConcreteTvs :: IdDetails -> ConcreteTyVars
idDetailsConcreteTvs = \ case
PrimOpId PrimOp
_ ConcreteTyVars
conc_tvs -> ConcreteTyVars
conc_tvs
RepPolyId ConcreteTyVars
conc_tvs -> ConcreteTyVars
conc_tvs
DataConWorkId DataCon
dc -> DataCon -> ConcreteTyVars
dataConConcreteTyVars DataCon
dc
DataConWrapId DataCon
dc -> DataCon -> ConcreteTyVars
dataConConcreteTyVars DataCon
dc
IdDetails
_ -> ConcreteTyVars
noConcreteTyVars
conLikesRecSelInfo :: [ConLike] -> [FieldLabelString] -> RecSelInfo
conLikesRecSelInfo :: [ConLike] -> [FieldLabelString] -> RecSelInfo
conLikesRecSelInfo [ConLike]
con_likes [FieldLabelString]
lbls
= RSI { rsi_def :: [ConLike]
rsi_def = [ConLike]
defs, rsi_undef :: [ConLike]
rsi_undef = [ConLike]
undefs }
where
!([ConLike]
defs,[ConLike]
undefs) = (ConLike -> Bool) -> [ConLike] -> ([ConLike], [ConLike])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition ConLike -> Bool
has_flds [ConLike]
con_likes
has_flds :: ConLike -> Bool
has_flds ConLike
dc = (FieldLabelString -> Bool) -> [FieldLabelString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (ConLike -> FieldLabelString -> Bool
has_fld ConLike
dc) [FieldLabelString]
lbls
has_fld :: ConLike -> FieldLabelString -> Bool
has_fld ConLike
dc FieldLabelString
lbl = (FieldLabel -> Bool) -> [FieldLabel] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ FieldLabel
fl -> FieldLabel -> FieldLabelString
flLabel FieldLabel
fl FieldLabelString -> FieldLabelString -> Bool
forall a. Eq a => a -> a -> Bool
== FieldLabelString
lbl) (ConLike -> [FieldLabel]
conLikeFieldLabels ConLike
dc)
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, Typeable RecSelParent
Typeable RecSelParent =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecSelParent -> c RecSelParent)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecSelParent)
-> (RecSelParent -> Constr)
-> (RecSelParent -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecSelParent))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecSelParent))
-> ((forall b. Data b => b -> b) -> RecSelParent -> RecSelParent)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecSelParent -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecSelParent -> r)
-> (forall u. (forall d. Data d => d -> u) -> RecSelParent -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> RecSelParent -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RecSelParent -> m RecSelParent)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecSelParent -> m RecSelParent)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecSelParent -> m RecSelParent)
-> Data RecSelParent
RecSelParent -> Constr
RecSelParent -> DataType
(forall b. Data b => b -> b) -> RecSelParent -> RecSelParent
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RecSelParent -> u
forall u. (forall d. Data d => d -> u) -> RecSelParent -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecSelParent -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecSelParent -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RecSelParent -> m RecSelParent
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecSelParent -> m RecSelParent
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecSelParent
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecSelParent -> c RecSelParent
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecSelParent)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecSelParent)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecSelParent -> c RecSelParent
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecSelParent -> c RecSelParent
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecSelParent
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecSelParent
$ctoConstr :: RecSelParent -> Constr
toConstr :: RecSelParent -> Constr
$cdataTypeOf :: RecSelParent -> DataType
dataTypeOf :: RecSelParent -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecSelParent)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecSelParent)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecSelParent)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecSelParent)
$cgmapT :: (forall b. Data b => b -> b) -> RecSelParent -> RecSelParent
gmapT :: (forall b. Data b => b -> b) -> RecSelParent -> RecSelParent
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecSelParent -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecSelParent -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecSelParent -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecSelParent -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RecSelParent -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RecSelParent -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RecSelParent -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RecSelParent -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RecSelParent -> m RecSelParent
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RecSelParent -> m RecSelParent
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecSelParent -> m RecSelParent
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecSelParent -> m RecSelParent
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecSelParent -> m RecSelParent
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecSelParent -> m RecSelParent
Data)
recSelParentName :: RecSelParent -> Name
recSelParentName :: RecSelParent -> Name
recSelParentName (RecSelData TyCon
tc) = TyCon -> Name
tyConName TyCon
tc
recSelParentName (RecSelPatSyn PatSyn
ps) = PatSyn -> Name
patSynName PatSyn
ps
recSelFirstConName :: RecSelParent -> Name
recSelFirstConName :: RecSelParent -> Name
recSelFirstConName (RecSelData TyCon
tc) = DataCon -> Name
dataConName (DataCon -> Name) -> DataCon -> Name
forall a b. (a -> b) -> a -> b
$ [DataCon] -> DataCon
forall a. HasCallStack => [a] -> a
head ([DataCon] -> DataCon) -> [DataCon] -> DataCon
forall a b. (a -> b) -> a -> b
$ TyCon -> [DataCon]
tyConDataCons TyCon
tc
recSelFirstConName (RecSelPatSyn PatSyn
ps) = PatSyn -> Name
patSynName PatSyn
ps
recSelParentCons :: RecSelParent -> [ConLike]
recSelParentCons :: RecSelParent -> [ConLike]
recSelParentCons (RecSelData TyCon
tc)
| TyCon -> Bool
isAlgTyCon TyCon
tc
= (DataCon -> ConLike) -> [DataCon] -> [ConLike]
forall a b. (a -> b) -> [a] -> [b]
map DataCon -> ConLike
RealDataCon ([DataCon] -> [ConLike]) -> [DataCon] -> [ConLike]
forall a b. (a -> b) -> a -> b
$ AlgTyConRhs -> [DataCon]
visibleDataCons
(AlgTyConRhs -> [DataCon]) -> AlgTyConRhs -> [DataCon]
forall a b. (a -> b) -> a -> b
$ TyCon -> AlgTyConRhs
algTyConRhs TyCon
tc
| Bool
otherwise
= []
recSelParentCons (RecSelPatSyn PatSyn
ps) = [PatSyn -> ConLike
PatSynCon PatSyn
ps]
instance Outputable RecSelParent where
ppr :: RecSelParent -> SDoc
ppr RecSelParent
p = case RecSelParent
p of
RecSelData TyCon
tc
| Just (TyCon
parent_tc, [Type]
tys) <- TyCon -> Maybe (TyCon, [Type])
tyConFamInst_maybe TyCon
tc
-> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyCon -> [Type] -> Type
mkTyConApp TyCon
parent_tc [Type]
tys)
| Bool
otherwise
-> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc
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 (RepPolyId {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RepPolyId"
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. (Num a, Bits a) => a -> Int -> a
clearBit Word64
bits Int
0)
OneShotInfo
OneShotLam -> Word64 -> BitField
BitField (Word64 -> Int -> Word64
forall a. (Num 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. (Num a, Bits a) => a -> Int -> a
clearBit Word64
bits Int
1)
CafInfo
NoCafRefs -> Word64 -> BitField
BitField (Word64 -> Int -> Word64
forall a. (Num 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)
lazifyDemandInfo :: IdInfo -> Maybe IdInfo
lazifyDemandInfo :: IdInfo -> Maybe IdInfo
lazifyDemandInfo info :: IdInfo
info@(IdInfo { demandInfo :: IdInfo -> Demand
demandInfo = Demand
dmd })
= IdInfo -> Maybe IdInfo
forall a. a -> Maybe a
Just (IdInfo
info {demandInfo = lazifyDmd dmd })
floatifyDemandInfo :: IdInfo -> Maybe IdInfo
floatifyDemandInfo :: IdInfo -> Maybe IdInfo
floatifyDemandInfo info :: IdInfo
info@(IdInfo { demandInfo :: IdInfo -> Demand
demandInfo = Demand
dmd })
= IdInfo -> Maybe IdInfo
forall a. a -> Maybe a
Just (IdInfo
info {demandInfo = floatifyDmd dmd })
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)