module GHC.Types.Id (
Var, Id, isId,
InVar, InId,
OutVar, OutId,
mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo,
mkLocalId, mkLocalCoVar, mkLocalIdOrCoVar,
mkLocalIdWithInfo, mkExportedLocalId, mkExportedVanillaId,
mkSysLocal, mkSysLocalM, mkSysLocalOrCoVar, mkSysLocalOrCoVarM,
mkUserLocal, mkUserLocalOrCoVar,
mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal,
mkScaledTemplateLocal,
mkWorkerId,
idName, idType, idMult, idScaledType, idUnique, idInfo, idDetails,
recordSelectorTyCon,
recordSelectorTyCon_maybe,
setIdName, setIdUnique, GHC.Types.Id.setIdType, setIdMult,
updateIdTypeButNotMult, updateIdTypeAndMult, updateIdTypeAndMultM,
setIdExported, setIdNotExported,
globaliseId, localiseId,
setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
zapLamIdInfo, zapIdDemandInfo, zapIdUsageInfo, zapIdUsageEnvInfo,
zapIdUsedOnceInfo, zapIdTailCallInfo,
zapFragileIdInfo, zapIdDmdSig, zapStableUnfolding,
transferPolyIdInfo, scaleIdBy, scaleVarBy,
isImplicitId, isDeadBinder,
isStrictId,
isExportedId, isLocalId, isGlobalId,
isRecordSelector, isNaughtyRecordSelector,
isPatSynRecordSelector,
isDataConRecordSelector,
isClassOpId,
isClassOpId_maybe, isDFunId,
isPrimOpId, isPrimOpId_maybe,
isFCallId, isFCallId_maybe,
isDataConWorkId, isDataConWorkId_maybe,
isDataConWrapId, isDataConWrapId_maybe,
isDataConId_maybe,
idDataCon,
isConLikeId, isWorkerLikeId, isDeadEndId, idIsFrom,
hasNoBinding,
JoinId, isJoinId, isJoinId_maybe, idJoinArity,
asJoinId, asJoinId_maybe, zapJoinId,
idInlinePragma, setInlinePragma, modifyInlinePragma,
idInlineActivation, setInlineActivation, idRuleMatchInfo,
setOneShotLambda, clearOneShotLambda,
updOneShotInfo, setIdOneShotInfo,
idArity,
idCallArity, idFunRepArity,
idSpecialisation, idCoreRules, idHasRules,
idCafInfo, idLFInfo_maybe,
idOneShotInfo,
idOccInfo,
IdUnfoldingFun, idUnfolding, realIdUnfolding,
alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun,
setIdUnfolding, zapIdUnfolding, setCaseBndrEvald,
setIdArity,
setIdCallArity,
setIdSpecialisation,
setIdCafInfo,
setIdOccInfo, zapIdOccInfo,
setIdLFInfo,
setIdDemandInfo,
setIdDmdSig,
setIdCprSig,
setIdCbvMarks,
idCbvMarks_maybe,
idCbvMarkArity,
asWorkerLikeId, asNonWorkerLikeId,
idDemandInfo,
idDmdSig,
idCprSig,
idTagSig_maybe,
setIdTagSig
) where
import GHC.Prelude
import GHC.Core ( CoreRule, isStableUnfolding, evaldUnfolding
, isCompulsoryUnfolding, Unfolding( NoUnfolding )
, IdUnfoldingFun, isEvaldUnfolding, hasSomeUnfolding, noUnfolding )
import GHC.Types.Id.Info
import GHC.Types.Basic
import GHC.Types.Var( Id, CoVar, JoinId,
InId, InVar,
OutId, OutVar,
idInfo, idDetails, setIdDetails, globaliseId,
isId, isLocalId, isGlobalId, isExportedId,
setIdMult, updateIdTypeAndMult, updateIdTypeButNotMult, updateIdTypeAndMultM)
import qualified GHC.Types.Var as Var
import GHC.Core.Type
import GHC.Types.RepType
import GHC.Core.DataCon
import GHC.Types.Demand
import GHC.Types.Cpr
import GHC.Types.Name
import GHC.Unit.Module
import GHC.Core.Class
import {-# SOURCE #-} GHC.Builtin.PrimOps (PrimOp)
import GHC.Types.ForeignCall
import GHC.Data.Maybe
import GHC.Types.SrcLoc
import GHC.Types.Unique
import GHC.Builtin.Uniques (mkBuiltinUnique)
import GHC.Types.Unique.Supply
import GHC.Data.FastString
import GHC.Core.Multiplicity
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Stg.InferTags.TagSig
infixl 1 `setIdUnfolding`,
`setIdArity`,
`setIdCallArity`,
`setIdOccInfo`,
`setIdOneShotInfo`,
`setIdSpecialisation`,
`setInlinePragma`,
`setInlineActivation`,
`idCafInfo`,
`setIdDemandInfo`,
`setIdDmdSig`,
`setIdCprSig`,
`asJoinId`,
`asJoinId_maybe`,
`setIdCbvMarks`
idName :: Id -> Name
idName :: Id -> Name
idName = Id -> Name
Var.varName
idUnique :: Id -> Unique
idUnique :: Id -> Unique
idUnique = Id -> Unique
Var.varUnique
idType :: Id -> Kind
idType :: Id -> Kind
idType = Id -> Kind
Var.varType
idMult :: Id -> Mult
idMult :: Id -> Kind
idMult = Id -> Kind
Var.varMult
idScaledType :: Id -> Scaled Type
idScaledType :: Id -> Scaled Kind
idScaledType Id
id = Kind -> Kind -> Scaled Kind
forall a. Kind -> a -> Scaled a
Scaled (Id -> Kind
idMult Id
id) (Id -> Kind
idType Id
id)
scaleIdBy :: Mult -> Id -> Id
scaleIdBy :: Kind -> Id -> Id
scaleIdBy Kind
m Id
id = Id -> Kind -> Id
setIdMult Id
id (Kind
m Kind -> Kind -> Kind
`mkMultMul` Id -> Kind
idMult Id
id)
scaleVarBy :: Mult -> Var -> Var
scaleVarBy :: Kind -> Id -> Id
scaleVarBy Kind
m Id
id
| Id -> Bool
isId Id
id = Kind -> Id -> Id
scaleIdBy Kind
m Id
id
| Bool
otherwise = Id
id
setIdName :: Id -> Name -> Id
setIdName :: Id -> Name -> Id
setIdName = Id -> Name -> Id
Var.setVarName
setIdUnique :: Id -> Unique -> Id
setIdUnique :: Id -> Unique -> Id
setIdUnique = Id -> Unique -> Id
Var.setVarUnique
setIdType :: Id -> Type -> Id
setIdType :: Id -> Kind -> Id
setIdType Id
id Kind
ty = Kind -> ()
seqType Kind
ty () -> Id -> Id
forall a b. a -> b -> b
`seq` Id -> Kind -> Id
Var.setVarType Id
id Kind
ty
setIdExported :: Id -> Id
setIdExported :: Id -> Id
setIdExported = Id -> Id
Var.setIdExported
setIdNotExported :: Id -> Id
setIdNotExported :: Id -> Id
setIdNotExported = Id -> Id
Var.setIdNotExported
localiseId :: Id -> Id
localiseId :: Id -> Id
localiseId Id
id
| Bool -> Bool -> Bool
forall a. HasCallStack => Bool -> a -> a
assert (Id -> Bool
isId Id
id) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Id -> Bool
isLocalId Id
id Bool -> Bool -> Bool
&& Name -> Bool
isInternalName Name
name
= Id
id
| Bool
otherwise
= IdDetails -> Name -> Kind -> Kind -> IdInfo -> Id
Var.mkLocalVar (Id -> IdDetails
idDetails Id
id) (Name -> Name
localiseName Name
name) (Id -> Kind
Var.varMult Id
id) (Id -> Kind
idType Id
id) ((() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
id)
where
name :: Name
name = Id -> Name
idName Id
id
lazySetIdInfo :: Id -> IdInfo -> Id
lazySetIdInfo :: Id -> IdInfo -> Id
lazySetIdInfo = Id -> IdInfo -> Id
Var.lazySetIdInfo
setIdInfo :: Id -> IdInfo -> Id
setIdInfo :: Id -> IdInfo -> Id
setIdInfo Id
id IdInfo
info = IdInfo
info IdInfo -> Id -> Id
forall a b. a -> b -> b
`seq` (Id -> IdInfo -> Id
lazySetIdInfo Id
id IdInfo
info)
modifyIdInfo :: HasDebugCallStack => (IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo :: (() :: Constraint) => (IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo IdInfo -> IdInfo
fn Id
id = Id -> IdInfo -> Id
setIdInfo Id
id (IdInfo -> IdInfo
fn ((() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
id))
maybeModifyIdInfo :: Maybe IdInfo -> Id -> Id
maybeModifyIdInfo :: Maybe IdInfo -> Id -> Id
maybeModifyIdInfo (Just IdInfo
new_info) Id
id = Id -> IdInfo -> Id
lazySetIdInfo Id
id IdInfo
new_info
maybeModifyIdInfo Maybe IdInfo
Nothing Id
id = Id
id
maybeModifyIdDetails :: Maybe IdDetails -> Id -> Id
maybeModifyIdDetails :: Maybe IdDetails -> Id -> Id
maybeModifyIdDetails (Just IdDetails
new_details) Id
id = Id -> IdDetails -> Id
setIdDetails Id
id IdDetails
new_details
maybeModifyIdDetails Maybe IdDetails
Nothing Id
id = Id
id
mkGlobalId :: IdDetails -> Name -> Type -> IdInfo -> Id
mkGlobalId :: IdDetails -> Name -> Kind -> IdInfo -> Id
mkGlobalId = IdDetails -> Name -> Kind -> IdInfo -> Id
Var.mkGlobalVar
mkVanillaGlobal :: Name -> Type -> Id
mkVanillaGlobal :: Name -> Kind -> Id
mkVanillaGlobal Name
name Kind
ty = Name -> Kind -> IdInfo -> Id
mkVanillaGlobalWithInfo Name
name Kind
ty IdInfo
vanillaIdInfo
mkVanillaGlobalWithInfo :: Name -> Type -> IdInfo -> Id
mkVanillaGlobalWithInfo :: Name -> Kind -> IdInfo -> Id
mkVanillaGlobalWithInfo = IdDetails -> Name -> Kind -> IdInfo -> Id
mkGlobalId IdDetails
VanillaId
mkLocalId :: HasDebugCallStack => Name -> Mult -> Type -> Id
mkLocalId :: (() :: Constraint) => Name -> Kind -> Kind -> Id
mkLocalId Name
name Kind
w Kind
ty = (() :: Constraint) => Name -> Kind -> Kind -> IdInfo -> Id
Name -> Kind -> Kind -> IdInfo -> Id
mkLocalIdWithInfo Name
name Kind
w (Bool -> Kind -> Kind
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Kind -> Bool
isCoVarType Kind
ty)) Kind
ty) IdInfo
vanillaIdInfo
mkLocalCoVar :: Name -> Type -> CoVar
mkLocalCoVar :: Name -> Kind -> Id
mkLocalCoVar Name
name Kind
ty
= Bool -> Id -> Id
forall a. HasCallStack => Bool -> a -> a
assert (Kind -> Bool
isCoVarType Kind
ty) (Id -> Id) -> Id -> Id
forall a b. (a -> b) -> a -> b
$
IdDetails -> Name -> Kind -> Kind -> IdInfo -> Id
Var.mkLocalVar IdDetails
CoVarId Name
name Kind
ManyTy Kind
ty IdInfo
vanillaIdInfo
mkLocalIdOrCoVar :: Name -> Mult -> Type -> Id
mkLocalIdOrCoVar :: Name -> Kind -> Kind -> Id
mkLocalIdOrCoVar Name
name Kind
w Kind
ty
| Kind -> Bool
isCoVarType Kind
ty = Name -> Kind -> Id
mkLocalCoVar Name
name Kind
ty
| Bool
otherwise = (() :: Constraint) => Name -> Kind -> Kind -> Id
Name -> Kind -> Kind -> Id
mkLocalId Name
name Kind
w Kind
ty
mkLocalIdWithInfo :: HasDebugCallStack => Name -> Mult -> Type -> IdInfo -> Id
mkLocalIdWithInfo :: (() :: Constraint) => Name -> Kind -> Kind -> IdInfo -> Id
mkLocalIdWithInfo Name
name Kind
w Kind
ty IdInfo
info =
IdDetails -> Name -> Kind -> Kind -> IdInfo -> Id
Var.mkLocalVar IdDetails
VanillaId Name
name Kind
w (Bool -> Kind -> Kind
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Kind -> Bool
isCoVarType Kind
ty)) Kind
ty) IdInfo
info
mkExportedLocalId :: IdDetails -> Name -> Type -> Id
mkExportedLocalId :: IdDetails -> Name -> Kind -> Id
mkExportedLocalId IdDetails
details Name
name Kind
ty = IdDetails -> Name -> Kind -> IdInfo -> Id
Var.mkExportedLocalVar IdDetails
details Name
name Kind
ty IdInfo
vanillaIdInfo
mkExportedVanillaId :: Name -> Type -> Id
mkExportedVanillaId :: Name -> Kind -> Id
mkExportedVanillaId Name
name Kind
ty = IdDetails -> Name -> Kind -> IdInfo -> Id
Var.mkExportedLocalVar IdDetails
VanillaId Name
name Kind
ty IdInfo
vanillaIdInfo
mkSysLocal :: FastString -> Unique -> Mult -> Type -> Id
mkSysLocal :: FastString -> Unique -> Kind -> Kind -> Id
mkSysLocal FastString
fs Unique
uniq Kind
w Kind
ty = Bool -> Id -> Id
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Kind -> Bool
isCoVarType Kind
ty)) (Id -> Id) -> Id -> Id
forall a b. (a -> b) -> a -> b
$
(() :: Constraint) => Name -> Kind -> Kind -> Id
Name -> Kind -> Kind -> Id
mkLocalId (Unique -> FastString -> Name
mkSystemVarName Unique
uniq FastString
fs) Kind
w Kind
ty
mkSysLocalOrCoVar :: FastString -> Unique -> Mult -> Type -> Id
mkSysLocalOrCoVar :: FastString -> Unique -> Kind -> Kind -> Id
mkSysLocalOrCoVar FastString
fs Unique
uniq Kind
w Kind
ty
= Name -> Kind -> Kind -> Id
mkLocalIdOrCoVar (Unique -> FastString -> Name
mkSystemVarName Unique
uniq FastString
fs) Kind
w Kind
ty
mkSysLocalM :: MonadUnique m => FastString -> Mult -> Type -> m Id
mkSysLocalM :: forall (m :: * -> *).
MonadUnique m =>
FastString -> Kind -> Kind -> m Id
mkSysLocalM FastString
fs Kind
w Kind
ty = m Unique
forall (m :: * -> *). MonadUnique m => m Unique
getUniqueM m Unique -> (Unique -> m Id) -> m Id
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Unique
uniq -> Id -> m Id
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> Unique -> Kind -> Kind -> Id
mkSysLocal FastString
fs Unique
uniq Kind
w Kind
ty))
mkSysLocalOrCoVarM :: MonadUnique m => FastString -> Mult -> Type -> m Id
mkSysLocalOrCoVarM :: forall (m :: * -> *).
MonadUnique m =>
FastString -> Kind -> Kind -> m Id
mkSysLocalOrCoVarM FastString
fs Kind
w Kind
ty
= m Unique
forall (m :: * -> *). MonadUnique m => m Unique
getUniqueM m Unique -> (Unique -> m Id) -> m Id
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Unique
uniq -> Id -> m Id
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> Unique -> Kind -> Kind -> Id
mkSysLocalOrCoVar FastString
fs Unique
uniq Kind
w Kind
ty))
mkUserLocal :: OccName -> Unique -> Mult -> Type -> SrcSpan -> Id
mkUserLocal :: OccName -> Unique -> Kind -> Kind -> SrcSpan -> Id
mkUserLocal OccName
occ Unique
uniq Kind
w Kind
ty SrcSpan
loc = Bool -> Id -> Id
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Kind -> Bool
isCoVarType Kind
ty)) (Id -> Id) -> Id -> Id
forall a b. (a -> b) -> a -> b
$
(() :: Constraint) => Name -> Kind -> Kind -> Id
Name -> Kind -> Kind -> Id
mkLocalId (Unique -> OccName -> SrcSpan -> Name
mkInternalName Unique
uniq OccName
occ SrcSpan
loc) Kind
w Kind
ty
mkUserLocalOrCoVar :: OccName -> Unique -> Mult -> Type -> SrcSpan -> Id
mkUserLocalOrCoVar :: OccName -> Unique -> Kind -> Kind -> SrcSpan -> Id
mkUserLocalOrCoVar OccName
occ Unique
uniq Kind
w Kind
ty SrcSpan
loc
= Name -> Kind -> Kind -> Id
mkLocalIdOrCoVar (Unique -> OccName -> SrcSpan -> Name
mkInternalName Unique
uniq OccName
occ SrcSpan
loc) Kind
w Kind
ty
mkWorkerId :: Unique -> Id -> Type -> Id
mkWorkerId :: Unique -> Id -> Kind -> Id
mkWorkerId Unique
uniq Id
unwrkr Kind
ty
= (() :: Constraint) => Name -> Kind -> Kind -> Id
Name -> Kind -> Kind -> Id
mkLocalId ((OccName -> OccName) -> Unique -> Name -> Name
mkDerivedInternalName OccName -> OccName
mkWorkerOcc Unique
uniq (Id -> Name
forall a. NamedThing a => a -> Name
getName Id
unwrkr)) Kind
ManyTy Kind
ty
mkTemplateLocal :: Int -> Type -> Id
mkTemplateLocal :: Arity -> Kind -> Id
mkTemplateLocal Arity
i Kind
ty = Arity -> Scaled Kind -> Id
mkScaledTemplateLocal Arity
i (Kind -> Scaled Kind
forall a. a -> Scaled a
unrestricted Kind
ty)
mkScaledTemplateLocal :: Int -> Scaled Type -> Id
mkScaledTemplateLocal :: Arity -> Scaled Kind -> Id
mkScaledTemplateLocal Arity
i (Scaled Kind
w Kind
ty) = FastString -> Unique -> Kind -> Kind -> Id
mkSysLocalOrCoVar (String -> FastString
fsLit String
"v") (Arity -> Unique
mkBuiltinUnique Arity
i) Kind
w Kind
ty
mkTemplateLocals :: [Type] -> [Id]
mkTemplateLocals :: [Kind] -> [Id]
mkTemplateLocals = Arity -> [Kind] -> [Id]
mkTemplateLocalsNum Arity
1
mkTemplateLocalsNum :: Int -> [Type] -> [Id]
mkTemplateLocalsNum :: Arity -> [Kind] -> [Id]
mkTemplateLocalsNum Arity
n [Kind]
tys = (Arity -> Kind -> Id) -> [Arity] -> [Kind] -> [Id]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Arity -> Kind -> Id
mkTemplateLocal [Arity
n..] [Kind]
tys
recordSelectorTyCon :: Id -> RecSelParent
recordSelectorTyCon :: Id -> RecSelParent
recordSelectorTyCon Id
id
= case Id -> Maybe RecSelParent
recordSelectorTyCon_maybe Id
id of
Just RecSelParent
parent -> RecSelParent
parent
Maybe RecSelParent
_ -> String -> RecSelParent
forall a. HasCallStack => String -> a
panic String
"recordSelectorTyCon"
recordSelectorTyCon_maybe :: Id -> Maybe RecSelParent
recordSelectorTyCon_maybe :: Id -> Maybe RecSelParent
recordSelectorTyCon_maybe Id
id
= case Id -> IdDetails
Var.idDetails Id
id of
RecSelId { sel_tycon :: IdDetails -> RecSelParent
sel_tycon = RecSelParent
parent } -> RecSelParent -> Maybe RecSelParent
forall a. a -> Maybe a
Just RecSelParent
parent
IdDetails
_ -> Maybe RecSelParent
forall a. Maybe a
Nothing
isRecordSelector :: Id -> Bool
isNaughtyRecordSelector :: Id -> Bool
isPatSynRecordSelector :: Id -> Bool
isDataConRecordSelector :: Id -> Bool
isPrimOpId :: Id -> Bool
isFCallId :: Id -> Bool
isDataConWorkId :: Id -> Bool
isDataConWrapId :: Id -> Bool
isDFunId :: Id -> Bool
isClassOpId :: Id -> Bool
isClassOpId_maybe :: Id -> Maybe Class
isPrimOpId_maybe :: Id -> Maybe PrimOp
isFCallId_maybe :: Id -> Maybe ForeignCall
isDataConWorkId_maybe :: Id -> Maybe DataCon
isDataConWrapId_maybe :: Id -> Maybe DataCon
isRecordSelector :: Id -> Bool
isRecordSelector Id
id = case Id -> IdDetails
Var.idDetails Id
id of
RecSelId {} -> Bool
True
IdDetails
_ -> Bool
False
isDataConRecordSelector :: Id -> Bool
isDataConRecordSelector Id
id = case Id -> IdDetails
Var.idDetails Id
id of
RecSelId {sel_tycon :: IdDetails -> RecSelParent
sel_tycon = RecSelData TyCon
_} -> Bool
True
IdDetails
_ -> Bool
False
isPatSynRecordSelector :: Id -> Bool
isPatSynRecordSelector Id
id = case Id -> IdDetails
Var.idDetails Id
id of
RecSelId {sel_tycon :: IdDetails -> RecSelParent
sel_tycon = RecSelPatSyn PatSyn
_} -> Bool
True
IdDetails
_ -> Bool
False
isNaughtyRecordSelector :: Id -> Bool
isNaughtyRecordSelector Id
id = case Id -> IdDetails
Var.idDetails Id
id of
RecSelId { sel_naughty :: IdDetails -> Bool
sel_naughty = Bool
n } -> Bool
n
IdDetails
_ -> Bool
False
isClassOpId :: Id -> Bool
isClassOpId Id
id = case Id -> IdDetails
Var.idDetails Id
id of
ClassOpId Class
_ -> Bool
True
IdDetails
_other -> Bool
False
isClassOpId_maybe :: Id -> Maybe Class
isClassOpId_maybe Id
id = case Id -> IdDetails
Var.idDetails Id
id of
ClassOpId Class
cls -> Class -> Maybe Class
forall a. a -> Maybe a
Just Class
cls
IdDetails
_other -> Maybe Class
forall a. Maybe a
Nothing
isPrimOpId :: Id -> Bool
isPrimOpId Id
id = case Id -> IdDetails
Var.idDetails Id
id of
PrimOpId {} -> Bool
True
IdDetails
_ -> Bool
False
isDFunId :: Id -> Bool
isDFunId Id
id = case Id -> IdDetails
Var.idDetails Id
id of
DFunId {} -> Bool
True
IdDetails
_ -> Bool
False
isPrimOpId_maybe :: Id -> Maybe PrimOp
isPrimOpId_maybe Id
id = case Id -> IdDetails
Var.idDetails Id
id of
PrimOpId PrimOp
op Bool
_ -> PrimOp -> Maybe PrimOp
forall a. a -> Maybe a
Just PrimOp
op
IdDetails
_ -> Maybe PrimOp
forall a. Maybe a
Nothing
isFCallId :: Id -> Bool
isFCallId Id
id = case Id -> IdDetails
Var.idDetails Id
id of
FCallId ForeignCall
_ -> Bool
True
IdDetails
_ -> Bool
False
isFCallId_maybe :: Id -> Maybe ForeignCall
isFCallId_maybe Id
id = case Id -> IdDetails
Var.idDetails Id
id of
FCallId ForeignCall
call -> ForeignCall -> Maybe ForeignCall
forall a. a -> Maybe a
Just ForeignCall
call
IdDetails
_ -> Maybe ForeignCall
forall a. Maybe a
Nothing
isDataConWorkId :: Id -> Bool
isDataConWorkId Id
id = case Id -> IdDetails
Var.idDetails Id
id of
DataConWorkId DataCon
_ -> Bool
True
IdDetails
_ -> Bool
False
isDataConWorkId_maybe :: Id -> Maybe DataCon
isDataConWorkId_maybe Id
id = case Id -> IdDetails
Var.idDetails Id
id of
DataConWorkId DataCon
con -> DataCon -> Maybe DataCon
forall a. a -> Maybe a
Just DataCon
con
IdDetails
_ -> Maybe DataCon
forall a. Maybe a
Nothing
isDataConWrapId :: Id -> Bool
isDataConWrapId Id
id = case Id -> IdDetails
Var.idDetails Id
id of
DataConWrapId DataCon
_ -> Bool
True
IdDetails
_ -> Bool
False
isDataConWrapId_maybe :: Id -> Maybe DataCon
isDataConWrapId_maybe Id
id = case Id -> IdDetails
Var.idDetails Id
id of
DataConWrapId DataCon
con -> DataCon -> Maybe DataCon
forall a. a -> Maybe a
Just DataCon
con
IdDetails
_ -> Maybe DataCon
forall a. Maybe a
Nothing
isDataConId_maybe :: Id -> Maybe DataCon
isDataConId_maybe :: Id -> Maybe DataCon
isDataConId_maybe Id
id = case Id -> IdDetails
Var.idDetails Id
id of
DataConWorkId DataCon
con -> DataCon -> Maybe DataCon
forall a. a -> Maybe a
Just DataCon
con
DataConWrapId DataCon
con -> DataCon -> Maybe DataCon
forall a. a -> Maybe a
Just DataCon
con
IdDetails
_ -> Maybe DataCon
forall a. Maybe a
Nothing
isWorkerLikeId :: Id -> Bool
isWorkerLikeId :: Id -> Bool
isWorkerLikeId Id
id = case Id -> IdDetails
Var.idDetails Id
id of
WorkerLikeId [CbvMark]
_ -> Bool
True
JoinId Arity
_ Just{} -> Bool
True
IdDetails
_ -> Bool
False
isJoinId :: Var -> Bool
isJoinId :: Id -> Bool
isJoinId Id
id
| Id -> Bool
isId Id
id = case Id -> IdDetails
Var.idDetails Id
id of
JoinId {} -> Bool
True
IdDetails
_ -> Bool
False
| Bool
otherwise = Bool
False
isJoinId_maybe :: Var -> Maybe JoinArity
isJoinId_maybe :: Id -> Maybe Arity
isJoinId_maybe Id
id
| Id -> Bool
isId Id
id = Bool -> SDoc -> Maybe Arity -> Maybe Arity
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Id -> Bool
isId Id
id) (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
id) (Maybe Arity -> Maybe Arity) -> Maybe Arity -> Maybe Arity
forall a b. (a -> b) -> a -> b
$
case Id -> IdDetails
Var.idDetails Id
id of
JoinId Arity
arity Maybe [CbvMark]
_marks -> Arity -> Maybe Arity
forall a. a -> Maybe a
Just Arity
arity
IdDetails
_ -> Maybe Arity
forall a. Maybe a
Nothing
| Bool
otherwise = Maybe Arity
forall a. Maybe a
Nothing
idDataCon :: Id -> DataCon
idDataCon :: Id -> DataCon
idDataCon Id
id = Id -> Maybe DataCon
isDataConId_maybe Id
id Maybe DataCon -> DataCon -> DataCon
forall a. Maybe a -> a -> a
`orElse` String -> SDoc -> DataCon
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"idDataCon" (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
id)
hasNoBinding :: Id -> Bool
hasNoBinding :: Id -> Bool
hasNoBinding Id
id = case Id -> IdDetails
Var.idDetails Id
id of
PrimOpId PrimOp
_ Bool
_ -> Bool
True
FCallId ForeignCall
_ -> Bool
True
DataConWorkId DataCon
dc -> DataCon -> Bool
isUnboxedTupleDataCon DataCon
dc Bool -> Bool -> Bool
|| DataCon -> Bool
isUnboxedSumDataCon DataCon
dc
IdDetails
_ -> Unfolding -> Bool
isCompulsoryUnfolding (Id -> Unfolding
realIdUnfolding Id
id)
isImplicitId :: Id -> Bool
isImplicitId :: Id -> Bool
isImplicitId Id
id
= case Id -> IdDetails
Var.idDetails Id
id of
FCallId {} -> Bool
True
ClassOpId {} -> Bool
True
PrimOpId {} -> Bool
True
DataConWorkId {} -> Bool
True
DataConWrapId {} -> Bool
True
IdDetails
_ -> Bool
False
idIsFrom :: Module -> Id -> Bool
idIsFrom :: Module -> Id -> Bool
idIsFrom Module
mod Id
id = Module -> Name -> Bool
nameIsLocalOrFrom Module
mod (Id -> Name
idName Id
id)
isDeadBinder :: Id -> Bool
isDeadBinder :: Id -> Bool
isDeadBinder Id
bndr | Id -> Bool
isId Id
bndr = OccInfo -> Bool
isDeadOcc (Id -> OccInfo
idOccInfo Id
bndr)
| Bool
otherwise = Bool
False
idJoinArity :: JoinId -> JoinArity
idJoinArity :: Id -> Arity
idJoinArity Id
id = Id -> Maybe Arity
isJoinId_maybe Id
id Maybe Arity -> Arity -> Arity
forall a. Maybe a -> a -> a
`orElse` String -> SDoc -> Arity
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"idJoinArity" (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
id)
asJoinId :: Id -> JoinArity -> JoinId
asJoinId :: Id -> Arity -> Id
asJoinId Id
id Arity
arity = Bool -> String -> SDoc -> Id -> Id
forall a. HasCallStack => Bool -> String -> SDoc -> a -> a
warnPprTrace (Bool -> Bool
not (Id -> Bool
isLocalId Id
id))
String
"global id being marked as join var" (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
id) (Id -> Id) -> Id -> Id
forall a b. (a -> b) -> a -> b
$
Bool -> String -> SDoc -> Id -> Id
forall a. HasCallStack => Bool -> String -> SDoc -> a -> a
warnPprTrace (Bool -> Bool
not (Id -> Bool
is_vanilla_or_join Id
id))
String
"asJoinId"
(Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
id SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IdDetails -> SDoc
pprIdDetails (Id -> IdDetails
idDetails Id
id)) (Id -> Id) -> Id -> Id
forall a b. (a -> b) -> a -> b
$
Id
id Id -> IdDetails -> Id
`setIdDetails` Arity -> Maybe [CbvMark] -> IdDetails
JoinId Arity
arity (Id -> Maybe [CbvMark]
idCbvMarks_maybe Id
id)
where
is_vanilla_or_join :: Id -> Bool
is_vanilla_or_join Id
id = case Id -> IdDetails
Var.idDetails Id
id of
IdDetails
VanillaId -> Bool
True
WorkerLikeId {} -> String -> SDoc -> Bool -> Bool
forall a. String -> SDoc -> a -> a
pprTraceDebug String
"asJoinId (call by value function)" (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
id) Bool
True
JoinId {} -> Bool
True
IdDetails
_ -> Bool
False
zapJoinId :: Id -> Id
zapJoinId :: Id -> Id
zapJoinId Id
jid | Id -> Bool
isJoinId Id
jid = Id -> Id
zapIdTailCallInfo (IdDetails
newIdDetails IdDetails -> Id -> Id
forall a b. a -> b -> b
`seq` Id
jid Id -> IdDetails -> Id
`setIdDetails` IdDetails
newIdDetails)
| Bool
otherwise = Id
jid
where
newIdDetails :: IdDetails
newIdDetails = case Id -> IdDetails
idDetails Id
jid of
JoinId Arity
_ (Just [CbvMark]
marks) -> [CbvMark] -> IdDetails
WorkerLikeId [CbvMark]
marks
JoinId Arity
_ Maybe [CbvMark]
Nothing -> [CbvMark] -> IdDetails
WorkerLikeId []
IdDetails
_ -> String -> IdDetails
forall a. HasCallStack => String -> a
panic String
"zapJoinId: newIdDetails can only be used if Id was a join Id."
asJoinId_maybe :: Id -> Maybe JoinArity -> Id
asJoinId_maybe :: Id -> Maybe Arity -> Id
asJoinId_maybe Id
id (Just Arity
arity) = Id -> Arity -> Id
asJoinId Id
id Arity
arity
asJoinId_maybe Id
id Maybe Arity
Nothing = Id -> Id
zapJoinId Id
id
idArity :: Id -> Arity
idArity :: Id -> Arity
idArity Id
id = IdInfo -> Arity
arityInfo ((() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
id)
setIdArity :: Id -> Arity -> Id
setIdArity :: Id -> Arity -> Id
setIdArity Id
id Arity
arity = (() :: Constraint) => (IdInfo -> IdInfo) -> Id -> Id
(IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo (IdInfo -> Arity -> IdInfo
`setArityInfo` Arity
arity) Id
id
idCallArity :: Id -> Arity
idCallArity :: Id -> Arity
idCallArity Id
id = IdInfo -> Arity
callArityInfo ((() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
id)
setIdCallArity :: Id -> Arity -> Id
setIdCallArity :: Id -> Arity -> Id
setIdCallArity Id
id Arity
arity = (() :: Constraint) => (IdInfo -> IdInfo) -> Id -> Id
(IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo (IdInfo -> Arity -> IdInfo
`setCallArityInfo` Arity
arity) Id
id
idFunRepArity :: Id -> RepArity
idFunRepArity :: Id -> Arity
idFunRepArity Id
x = Arity -> Kind -> Arity
countFunRepArgs (Id -> Arity
idArity Id
x) (Id -> Kind
idType Id
x)
isDeadEndId :: Var -> Bool
isDeadEndId :: Id -> Bool
isDeadEndId Id
v
| Id -> Bool
isId Id
v = DmdSig -> Bool
isDeadEndSig (Id -> DmdSig
idDmdSig Id
v)
| Bool
otherwise = Bool
False
idDmdSig :: Id -> DmdSig
idDmdSig :: Id -> DmdSig
idDmdSig Id
id = IdInfo -> DmdSig
dmdSigInfo ((() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
id)
setIdDmdSig :: Id -> DmdSig -> Id
setIdDmdSig :: Id -> DmdSig -> Id
setIdDmdSig Id
id DmdSig
sig = (() :: Constraint) => (IdInfo -> IdInfo) -> Id -> Id
(IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo (IdInfo -> DmdSig -> IdInfo
`setDmdSigInfo` DmdSig
sig) Id
id
idCprSig :: Id -> CprSig
idCprSig :: Id -> CprSig
idCprSig Id
id = IdInfo -> CprSig
cprSigInfo ((() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
id)
setIdCprSig :: Id -> CprSig -> Id
setIdCprSig :: Id -> CprSig -> Id
setIdCprSig Id
id CprSig
sig = (() :: Constraint) => (IdInfo -> IdInfo) -> Id -> Id
(IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo (\IdInfo
info -> IdInfo -> CprSig -> IdInfo
setCprSigInfo IdInfo
info CprSig
sig) Id
id
zapIdDmdSig :: Id -> Id
zapIdDmdSig :: Id -> Id
zapIdDmdSig Id
id = (() :: Constraint) => (IdInfo -> IdInfo) -> Id -> Id
(IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo (IdInfo -> DmdSig -> IdInfo
`setDmdSigInfo` DmdSig
nopSig) Id
id
isStrictId :: Id -> Bool
isStrictId :: Id -> Bool
isStrictId Id
id
| Bool -> SDoc -> Bool -> Bool
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Id -> Bool
isId Id
id) (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"isStrictId: not an id: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
id) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
Id -> Bool
isJoinId Id
id = Bool
False
| Bool
otherwise = (() :: Constraint) => Kind -> Bool
Kind -> Bool
isStrictType (Id -> Kind
idType Id
id) Bool -> Bool -> Bool
||
Demand -> Bool
isStrUsedDmd (Id -> Demand
idDemandInfo Id
id)
idTagSig_maybe :: Id -> Maybe TagSig
idTagSig_maybe :: Id -> Maybe TagSig
idTagSig_maybe = IdInfo -> Maybe TagSig
tagSig (IdInfo -> Maybe TagSig) -> (Id -> IdInfo) -> Id -> Maybe TagSig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo
idUnfolding :: IdUnfoldingFun
idUnfolding :: Id -> Unfolding
idUnfolding Id
id = IdInfo -> Unfolding
unfoldingInfo ((() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
id)
noUnfoldingFun :: IdUnfoldingFun
noUnfoldingFun :: Id -> Unfolding
noUnfoldingFun Id
_id = Unfolding
noUnfolding
alwaysActiveUnfoldingFun :: IdUnfoldingFun
alwaysActiveUnfoldingFun :: Id -> Unfolding
alwaysActiveUnfoldingFun Id
id
| Activation -> Bool
isAlwaysActive (Id -> Activation
idInlineActivation Id
id) = Id -> Unfolding
idUnfolding Id
id
| Bool
otherwise = Unfolding
noUnfolding
whenActiveUnfoldingFun :: (Activation -> Bool) -> IdUnfoldingFun
whenActiveUnfoldingFun :: (Activation -> Bool) -> Id -> Unfolding
whenActiveUnfoldingFun Activation -> Bool
is_active Id
id
| Activation -> Bool
is_active (Id -> Activation
idInlineActivation Id
id) = Id -> Unfolding
idUnfolding Id
id
| Bool
otherwise = Unfolding
NoUnfolding
realIdUnfolding :: Id -> Unfolding
realIdUnfolding :: Id -> Unfolding
realIdUnfolding Id
id = IdInfo -> Unfolding
realUnfoldingInfo ((() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
id)
setIdUnfolding :: Id -> Unfolding -> Id
setIdUnfolding :: Id -> Unfolding -> Id
setIdUnfolding Id
id Unfolding
unfolding = (() :: Constraint) => (IdInfo -> IdInfo) -> Id -> Id
(IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo (IdInfo -> Unfolding -> IdInfo
`setUnfoldingInfo` Unfolding
unfolding) Id
id
idDemandInfo :: Id -> Demand
idDemandInfo :: Id -> Demand
idDemandInfo Id
id = IdInfo -> Demand
demandInfo ((() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
id)
setIdDemandInfo :: Id -> Demand -> Id
setIdDemandInfo :: Id -> Demand -> Id
setIdDemandInfo Id
id Demand
dmd = (() :: Constraint) => (IdInfo -> IdInfo) -> Id -> Id
(IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo (IdInfo -> Demand -> IdInfo
`setDemandInfo` Demand
dmd) Id
id
setIdTagSig :: Id -> TagSig -> Id
setIdTagSig :: Id -> TagSig -> Id
setIdTagSig Id
id TagSig
sig = (() :: Constraint) => (IdInfo -> IdInfo) -> Id -> Id
(IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo (IdInfo -> TagSig -> IdInfo
`setTagSig` TagSig
sig) Id
id
setIdCbvMarks :: Id -> [CbvMark] -> Id
setIdCbvMarks :: Id -> [CbvMark] -> Id
setIdCbvMarks Id
id [CbvMark]
marks
| Bool -> Bool
not ((CbvMark -> Bool) -> [CbvMark] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any CbvMark -> Bool
isMarkedCbv [CbvMark]
marks) = Id
id
| Bool
otherwise =
case Id -> IdDetails
idDetails Id
id of
IdDetails
VanillaId -> Id
id Id -> IdDetails -> Id
`setIdDetails` ([CbvMark] -> IdDetails
WorkerLikeId [CbvMark]
trimmedMarks)
JoinId Arity
arity Maybe [CbvMark]
_ -> Id
id Id -> IdDetails -> Id
`setIdDetails` (Arity -> Maybe [CbvMark] -> IdDetails
JoinId Arity
arity ([CbvMark] -> Maybe [CbvMark]
forall a. a -> Maybe a
Just [CbvMark]
trimmedMarks))
WorkerLikeId [CbvMark]
_ -> Id
id Id -> IdDetails -> Id
`setIdDetails` ([CbvMark] -> IdDetails
WorkerLikeId [CbvMark]
trimmedMarks)
RecSelId{} -> Id
id
DFunId{} -> Id
id
IdDetails
_ -> String -> SDoc -> Id -> Id
forall a. String -> SDoc -> a -> a
pprTrace String
"setIdCbvMarks: Unable to set cbv marks for" (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
id SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"marks:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [CbvMark] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [CbvMark]
marks SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"idDetails:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> IdDetails -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Id -> IdDetails
idDetails Id
id)) Id
id
where
trimmedMarks :: [CbvMark]
trimmedMarks = (CbvMark -> Bool) -> [CbvMark] -> [CbvMark]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEndLE (Bool -> Bool
not (Bool -> Bool) -> (CbvMark -> Bool) -> CbvMark -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CbvMark -> Bool
isMarkedCbv) ([CbvMark] -> [CbvMark]) -> [CbvMark] -> [CbvMark]
forall a b. (a -> b) -> a -> b
$ Arity -> [CbvMark] -> [CbvMark]
forall a. Arity -> [a] -> [a]
take (Id -> Arity
idArity Id
id) [CbvMark]
marks
idCbvMarks_maybe :: Id -> Maybe [CbvMark]
idCbvMarks_maybe :: Id -> Maybe [CbvMark]
idCbvMarks_maybe Id
id = case Id -> IdDetails
idDetails Id
id of
WorkerLikeId [CbvMark]
marks -> [CbvMark] -> Maybe [CbvMark]
forall a. a -> Maybe a
Just [CbvMark]
marks
JoinId Arity
_arity Maybe [CbvMark]
marks -> Maybe [CbvMark]
marks
IdDetails
_ -> Maybe [CbvMark]
forall a. Maybe a
Nothing
idCbvMarkArity :: Id -> Arity
idCbvMarkArity :: Id -> Arity
idCbvMarkArity Id
fn = Arity -> ([CbvMark] -> Arity) -> Maybe [CbvMark] -> Arity
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Arity
0 [CbvMark] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length (Id -> Maybe [CbvMark]
idCbvMarks_maybe Id
fn)
asNonWorkerLikeId :: Id -> Id
asNonWorkerLikeId :: Id -> Id
asNonWorkerLikeId Id
id =
let details :: Maybe IdDetails
details = case Id -> IdDetails
idDetails Id
id of
WorkerLikeId{} -> IdDetails -> Maybe IdDetails
forall a. a -> Maybe a
Just (IdDetails -> Maybe IdDetails) -> IdDetails -> Maybe IdDetails
forall a b. (a -> b) -> a -> b
$ IdDetails
VanillaId
JoinId Arity
arity Just{} -> IdDetails -> Maybe IdDetails
forall a. a -> Maybe a
Just (IdDetails -> Maybe IdDetails) -> IdDetails -> Maybe IdDetails
forall a b. (a -> b) -> a -> b
$ Arity -> Maybe [CbvMark] -> IdDetails
JoinId Arity
arity Maybe [CbvMark]
forall a. Maybe a
Nothing
IdDetails
_ -> Maybe IdDetails
forall a. Maybe a
Nothing
in Maybe IdDetails -> Id -> Id
maybeModifyIdDetails Maybe IdDetails
details Id
id
asWorkerLikeId :: Id -> Id
asWorkerLikeId :: Id -> Id
asWorkerLikeId Id
id =
let details :: Maybe IdDetails
details = case Id -> IdDetails
idDetails Id
id of
WorkerLikeId{} -> Maybe IdDetails
forall a. Maybe a
Nothing
JoinId Arity
_arity Just{} -> Maybe IdDetails
forall a. Maybe a
Nothing
JoinId Arity
arity Maybe [CbvMark]
Nothing -> IdDetails -> Maybe IdDetails
forall a. a -> Maybe a
Just (Arity -> Maybe [CbvMark] -> IdDetails
JoinId Arity
arity ([CbvMark] -> Maybe [CbvMark]
forall a. a -> Maybe a
Just []))
IdDetails
VanillaId -> IdDetails -> Maybe IdDetails
forall a. a -> Maybe a
Just (IdDetails -> Maybe IdDetails) -> IdDetails -> Maybe IdDetails
forall a b. (a -> b) -> a -> b
$ [CbvMark] -> IdDetails
WorkerLikeId []
IdDetails
_ -> Maybe IdDetails
forall a. Maybe a
Nothing
in Maybe IdDetails -> Id -> Id
maybeModifyIdDetails Maybe IdDetails
details Id
id
setCaseBndrEvald :: StrictnessMark -> Id -> Id
setCaseBndrEvald :: StrictnessMark -> Id -> Id
setCaseBndrEvald StrictnessMark
str Id
id
| StrictnessMark -> Bool
isMarkedStrict StrictnessMark
str = Id
id Id -> Unfolding -> Id
`setIdUnfolding` Unfolding
evaldUnfolding
| Bool
otherwise = Id
id
zapIdUnfolding :: Id -> Id
zapIdUnfolding :: Id -> Id
zapIdUnfolding Id
v
| Id -> Bool
isId Id
v, Unfolding -> Bool
hasSomeUnfolding (Id -> Unfolding
idUnfolding Id
v) = Id -> Unfolding -> Id
setIdUnfolding Id
v Unfolding
noUnfolding
| Bool
otherwise = Id
v
idSpecialisation :: Id -> RuleInfo
idSpecialisation :: Id -> RuleInfo
idSpecialisation Id
id = IdInfo -> RuleInfo
ruleInfo ((() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
id)
idCoreRules :: Id -> [CoreRule]
idCoreRules :: Id -> [CoreRule]
idCoreRules Id
id = RuleInfo -> [CoreRule]
ruleInfoRules (Id -> RuleInfo
idSpecialisation Id
id)
idHasRules :: Id -> Bool
idHasRules :: Id -> Bool
idHasRules Id
id = Bool -> Bool
not (RuleInfo -> Bool
isEmptyRuleInfo (Id -> RuleInfo
idSpecialisation Id
id))
setIdSpecialisation :: Id -> RuleInfo -> Id
setIdSpecialisation :: Id -> RuleInfo -> Id
setIdSpecialisation Id
id RuleInfo
spec_info = (() :: Constraint) => (IdInfo -> IdInfo) -> Id -> Id
(IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo (IdInfo -> RuleInfo -> IdInfo
`setRuleInfo` RuleInfo
spec_info) Id
id
idCafInfo :: Id -> CafInfo
idCafInfo :: Id -> CafInfo
idCafInfo Id
id = IdInfo -> CafInfo
cafInfo ((() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
id)
setIdCafInfo :: Id -> CafInfo -> Id
setIdCafInfo :: Id -> CafInfo -> Id
setIdCafInfo Id
id CafInfo
caf_info = (() :: Constraint) => (IdInfo -> IdInfo) -> Id -> Id
(IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo (IdInfo -> CafInfo -> IdInfo
`setCafInfo` CafInfo
caf_info) Id
id
idLFInfo_maybe :: Id -> Maybe LambdaFormInfo
idLFInfo_maybe :: Id -> Maybe LambdaFormInfo
idLFInfo_maybe = IdInfo -> Maybe LambdaFormInfo
lfInfo (IdInfo -> Maybe LambdaFormInfo)
-> (Id -> IdInfo) -> Id -> Maybe LambdaFormInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo
setIdLFInfo :: Id -> LambdaFormInfo -> Id
setIdLFInfo :: Id -> LambdaFormInfo -> Id
setIdLFInfo Id
id LambdaFormInfo
lf = (() :: Constraint) => (IdInfo -> IdInfo) -> Id -> Id
(IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo (IdInfo -> LambdaFormInfo -> IdInfo
`setLFInfo` LambdaFormInfo
lf) Id
id
idOccInfo :: Id -> OccInfo
idOccInfo :: Id -> OccInfo
idOccInfo Id
id = IdInfo -> OccInfo
occInfo ((() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
id)
setIdOccInfo :: Id -> OccInfo -> Id
setIdOccInfo :: Id -> OccInfo -> Id
setIdOccInfo Id
id OccInfo
occ_info = (() :: Constraint) => (IdInfo -> IdInfo) -> Id -> Id
(IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo (IdInfo -> OccInfo -> IdInfo
`setOccInfo` OccInfo
occ_info) Id
id
zapIdOccInfo :: Id -> Id
zapIdOccInfo :: Id -> Id
zapIdOccInfo Id
b = Id
b Id -> OccInfo -> Id
`setIdOccInfo` OccInfo
noOccInfo
idInlinePragma :: Id -> InlinePragma
idInlinePragma :: Id -> InlinePragma
idInlinePragma Id
id = IdInfo -> InlinePragma
inlinePragInfo ((() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
id)
setInlinePragma :: Id -> InlinePragma -> Id
setInlinePragma :: Id -> InlinePragma -> Id
setInlinePragma Id
id InlinePragma
prag = (() :: Constraint) => (IdInfo -> IdInfo) -> Id -> Id
(IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo (IdInfo -> InlinePragma -> IdInfo
`setInlinePragInfo` InlinePragma
prag) Id
id
modifyInlinePragma :: Id -> (InlinePragma -> InlinePragma) -> Id
modifyInlinePragma :: Id -> (InlinePragma -> InlinePragma) -> Id
modifyInlinePragma Id
id InlinePragma -> InlinePragma
fn = (() :: Constraint) => (IdInfo -> IdInfo) -> Id -> Id
(IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo (\IdInfo
info -> IdInfo
info IdInfo -> InlinePragma -> IdInfo
`setInlinePragInfo` (InlinePragma -> InlinePragma
fn (IdInfo -> InlinePragma
inlinePragInfo IdInfo
info))) Id
id
idInlineActivation :: Id -> Activation
idInlineActivation :: Id -> Activation
idInlineActivation Id
id = InlinePragma -> Activation
inlinePragmaActivation (Id -> InlinePragma
idInlinePragma Id
id)
setInlineActivation :: Id -> Activation -> Id
setInlineActivation :: Id -> Activation -> Id
setInlineActivation Id
id Activation
act = Id -> (InlinePragma -> InlinePragma) -> Id
modifyInlinePragma Id
id (\InlinePragma
prag -> InlinePragma -> Activation -> InlinePragma
setInlinePragmaActivation InlinePragma
prag Activation
act)
idRuleMatchInfo :: Id -> RuleMatchInfo
idRuleMatchInfo :: Id -> RuleMatchInfo
idRuleMatchInfo Id
id = InlinePragma -> RuleMatchInfo
inlinePragmaRuleMatchInfo (Id -> InlinePragma
idInlinePragma Id
id)
isConLikeId :: Id -> Bool
isConLikeId :: Id -> Bool
isConLikeId Id
id = RuleMatchInfo -> Bool
isConLike (Id -> RuleMatchInfo
idRuleMatchInfo Id
id)
idOneShotInfo :: Id -> OneShotInfo
idOneShotInfo :: Id -> OneShotInfo
idOneShotInfo Id
id = IdInfo -> OneShotInfo
oneShotInfo ((() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
id)
setOneShotLambda :: Id -> Id
setOneShotLambda :: Id -> Id
setOneShotLambda Id
id = (() :: Constraint) => (IdInfo -> IdInfo) -> Id -> Id
(IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo (IdInfo -> OneShotInfo -> IdInfo
`setOneShotInfo` OneShotInfo
OneShotLam) Id
id
clearOneShotLambda :: Id -> Id
clearOneShotLambda :: Id -> Id
clearOneShotLambda Id
id = (() :: Constraint) => (IdInfo -> IdInfo) -> Id -> Id
(IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo (IdInfo -> OneShotInfo -> IdInfo
`setOneShotInfo` OneShotInfo
NoOneShotInfo) Id
id
setIdOneShotInfo :: Id -> OneShotInfo -> Id
setIdOneShotInfo :: Id -> OneShotInfo -> Id
setIdOneShotInfo Id
id OneShotInfo
one_shot = (() :: Constraint) => (IdInfo -> IdInfo) -> Id -> Id
(IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo (IdInfo -> OneShotInfo -> IdInfo
`setOneShotInfo` OneShotInfo
one_shot) Id
id
updOneShotInfo :: Id -> OneShotInfo -> Id
updOneShotInfo :: Id -> OneShotInfo -> Id
updOneShotInfo Id
id OneShotInfo
one_shot
| Bool
do_upd = Id -> OneShotInfo -> Id
setIdOneShotInfo Id
id OneShotInfo
one_shot
| Bool
otherwise = Id
id
where
do_upd :: Bool
do_upd = case (Id -> OneShotInfo
idOneShotInfo Id
id, OneShotInfo
one_shot) of
(OneShotInfo
NoOneShotInfo, OneShotInfo
_) -> Bool
True
(OneShotInfo
OneShotLam, OneShotInfo
_) -> Bool
False
zapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id
zapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id
zapInfo IdInfo -> Maybe IdInfo
zapper Id
id = Maybe IdInfo -> Id -> Id
maybeModifyIdInfo (IdInfo -> Maybe IdInfo
zapper ((() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
id)) Id
id
zapLamIdInfo :: Id -> Id
zapLamIdInfo :: Id -> Id
zapLamIdInfo = (IdInfo -> Maybe IdInfo) -> Id -> Id
zapInfo IdInfo -> Maybe IdInfo
zapLamInfo
zapFragileIdInfo :: Id -> Id
zapFragileIdInfo :: Id -> Id
zapFragileIdInfo = (IdInfo -> Maybe IdInfo) -> Id -> Id
zapInfo IdInfo -> Maybe IdInfo
zapFragileInfo
zapIdDemandInfo :: Id -> Id
zapIdDemandInfo :: Id -> Id
zapIdDemandInfo = (IdInfo -> Maybe IdInfo) -> Id -> Id
zapInfo IdInfo -> Maybe IdInfo
zapDemandInfo
zapIdUsageInfo :: Id -> Id
zapIdUsageInfo :: Id -> Id
zapIdUsageInfo = (IdInfo -> Maybe IdInfo) -> Id -> Id
zapInfo IdInfo -> Maybe IdInfo
zapUsageInfo
zapIdUsageEnvInfo :: Id -> Id
zapIdUsageEnvInfo :: Id -> Id
zapIdUsageEnvInfo = (IdInfo -> Maybe IdInfo) -> Id -> Id
zapInfo IdInfo -> Maybe IdInfo
zapUsageEnvInfo
zapIdUsedOnceInfo :: Id -> Id
zapIdUsedOnceInfo :: Id -> Id
zapIdUsedOnceInfo = (IdInfo -> Maybe IdInfo) -> Id -> Id
zapInfo IdInfo -> Maybe IdInfo
zapUsedOnceInfo
zapIdTailCallInfo :: Id -> Id
zapIdTailCallInfo :: Id -> Id
zapIdTailCallInfo = (IdInfo -> Maybe IdInfo) -> Id -> Id
zapInfo IdInfo -> Maybe IdInfo
zapTailCallInfo
zapStableUnfolding :: Id -> Id
zapStableUnfolding :: Id -> Id
zapStableUnfolding Id
id
| Unfolding -> Bool
isStableUnfolding (Id -> Unfolding
realIdUnfolding Id
id) = Id -> Unfolding -> Id
setIdUnfolding Id
id Unfolding
NoUnfolding
| Bool
otherwise = Id
id
transferPolyIdInfo :: Id
-> [Var]
-> Id
-> Id
transferPolyIdInfo :: Id -> [Id] -> Id -> Id
transferPolyIdInfo Id
old_id [Id]
abstract_wrt Id
new_id
= (() :: Constraint) => (IdInfo -> IdInfo) -> Id -> Id
(IdInfo -> IdInfo) -> Id -> Id
modifyIdInfo IdInfo -> IdInfo
transfer Id
new_id Id -> [CbvMark] -> Id
`setIdCbvMarks` [CbvMark]
new_cbv_marks
where
arity_increase :: Arity
arity_increase = (Id -> Bool) -> [Id] -> Arity
forall a. (a -> Bool) -> [a] -> Arity
count Id -> Bool
isId [Id]
abstract_wrt
old_info :: IdInfo
old_info = (() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
old_id
old_arity :: Arity
old_arity = IdInfo -> Arity
arityInfo IdInfo
old_info
old_inline_prag :: InlinePragma
old_inline_prag = IdInfo -> InlinePragma
inlinePragInfo IdInfo
old_info
old_occ_info :: OccInfo
old_occ_info = IdInfo -> OccInfo
occInfo IdInfo
old_info
new_arity :: Arity
new_arity = Arity
old_arity Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
+ Arity
arity_increase
new_occ_info :: OccInfo
new_occ_info = OccInfo -> OccInfo
zapOccTailCallInfo OccInfo
old_occ_info
old_strictness :: DmdSig
old_strictness = IdInfo -> DmdSig
dmdSigInfo IdInfo
old_info
new_strictness :: DmdSig
new_strictness = Arity -> DmdSig -> DmdSig
prependArgsDmdSig Arity
arity_increase DmdSig
old_strictness
old_cpr :: CprSig
old_cpr = IdInfo -> CprSig
cprSigInfo IdInfo
old_info
new_cpr :: CprSig
new_cpr = Arity -> CprSig -> CprSig
prependArgsCprSig Arity
arity_increase CprSig
old_cpr
old_cbv_marks :: [CbvMark]
old_cbv_marks = [CbvMark] -> Maybe [CbvMark] -> [CbvMark]
forall a. a -> Maybe a -> a
fromMaybe (Arity -> CbvMark -> [CbvMark]
forall a. Arity -> a -> [a]
replicate Arity
old_arity CbvMark
NotMarkedCbv) (Id -> Maybe [CbvMark]
idCbvMarks_maybe Id
old_id)
abstr_cbv_marks :: [CbvMark]
abstr_cbv_marks = (Id -> Maybe CbvMark) -> [Id] -> [CbvMark]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Id -> Maybe CbvMark
getMark [Id]
abstract_wrt
new_cbv_marks :: [CbvMark]
new_cbv_marks = [CbvMark]
abstr_cbv_marks [CbvMark] -> [CbvMark] -> [CbvMark]
forall a. [a] -> [a] -> [a]
++ [CbvMark]
old_cbv_marks
getMark :: Id -> Maybe CbvMark
getMark Id
v
| Bool -> Bool
not (Id -> Bool
isId Id
v)
= Maybe CbvMark
forall a. Maybe a
Nothing
| Id -> Bool
isId Id
v
, Unfolding -> Bool
isEvaldUnfolding (Id -> Unfolding
idUnfolding Id
v)
, Kind -> Bool
mightBeLiftedType (Id -> Kind
idType Id
v)
= CbvMark -> Maybe CbvMark
forall a. a -> Maybe a
Just CbvMark
MarkedCbv
| Bool
otherwise = CbvMark -> Maybe CbvMark
forall a. a -> Maybe a
Just CbvMark
NotMarkedCbv
transfer :: IdInfo -> IdInfo
transfer IdInfo
new_info = IdInfo
new_info IdInfo -> Arity -> IdInfo
`setArityInfo` Arity
new_arity
IdInfo -> InlinePragma -> IdInfo
`setInlinePragInfo` InlinePragma
old_inline_prag
IdInfo -> OccInfo -> IdInfo
`setOccInfo` OccInfo
new_occ_info
IdInfo -> DmdSig -> IdInfo
`setDmdSigInfo` DmdSig
new_strictness
IdInfo -> CprSig -> IdInfo
`setCprSigInfo` CprSig
new_cpr