{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module GHC.StgToCmm.Closure (
DynTag, tagForCon, isSmallFamily,
idPrimRep, isVoidRep, isGcPtrRep, addIdReps, addArgReps,
argPrimRep,
NonVoid(..), fromNonVoid, nonVoidIds, nonVoidStgArgs,
assertNonVoidIds, assertNonVoidStgArgs,
LambdaFormInfo,
StandardFormInfo,
mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,
mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
mkLFStringLit,
lfDynTag,
isLFThunk, isLFReEntrant, lfUpdatable,
CgLoc(..), CallMethod(..),
nodeMustPointToIt, isKnownFun, funTag, tagForArity,
getCallMethod,
ClosureInfo,
mkClosureInfo,
mkCmmInfo,
closureLFInfo, closureName,
closureInfoLabel, staticClosureLabel,
closureSlowEntryLabel, closureLocalEntryLabel,
closureUpdReqd,
closureReEntrant, closureFunInfo,
isToplevClosure,
blackHoleOnEntry,
isStaticClosure,
mkDataConInfoTable,
cafBlackHoleInfoTable,
indStaticInfoTable,
staticClosureNeedsLink,
mkClosureInfoTableLabel
) where
import GHC.Prelude
import GHC.Platform
import GHC.Platform.Profile
import GHC.Stg.Syntax
import GHC.Runtime.Heap.Layout
import GHC.Cmm
import GHC.Cmm.Utils
import GHC.StgToCmm.Types
import GHC.StgToCmm.Sequel
import GHC.Types.CostCentre
import GHC.Cmm.BlockId
import GHC.Cmm.CLabel
import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Core.DataCon
import GHC.Types.Name
import GHC.Core.Type
import GHC.Core.TyCo.Rep
import GHC.Tc.Utils.TcType
import GHC.Core.TyCon
import GHC.Types.RepType
import GHC.Types.Basic
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import Data.Coerce (coerce)
import qualified Data.ByteString.Char8 as BS8
import GHC.StgToCmm.Config
import GHC.Stg.InferTags.TagSig (isTaggedSig)
data CgLoc
= CmmLoc CmmExpr
| LneLoc BlockId [LocalReg]
instance OutputableP Platform CgLoc where
pdoc :: Platform -> CgLoc -> SDoc
pdoc = Platform -> CgLoc -> SDoc
pprCgLoc
pprCgLoc :: Platform -> CgLoc -> SDoc
pprCgLoc :: Platform -> CgLoc -> SDoc
pprCgLoc Platform
platform = \case
CmmLoc CmmExpr
e -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cmm" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CmmExpr -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CmmExpr
e
LneLoc BlockId
b [LocalReg]
rs -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"lne" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> BlockId -> SDoc
forall a. Outputable a => a -> SDoc
ppr BlockId
b SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [LocalReg] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [LocalReg]
rs
isKnownFun :: LambdaFormInfo -> Bool
isKnownFun :: LambdaFormInfo -> Bool
isKnownFun LFReEntrant{} = Bool
True
isKnownFun LambdaFormInfo
LFLetNoEscape = Bool
True
isKnownFun LambdaFormInfo
_ = Bool
False
newtype NonVoid a = NonVoid a
deriving (NonVoid a -> NonVoid a -> Bool
(NonVoid a -> NonVoid a -> Bool)
-> (NonVoid a -> NonVoid a -> Bool) -> Eq (NonVoid a)
forall a. Eq a => NonVoid a -> NonVoid a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => NonVoid a -> NonVoid a -> Bool
== :: NonVoid a -> NonVoid a -> Bool
$c/= :: forall a. Eq a => NonVoid a -> NonVoid a -> Bool
/= :: NonVoid a -> NonVoid a -> Bool
Eq, RepArity -> NonVoid a -> ShowS
[NonVoid a] -> ShowS
NonVoid a -> String
(RepArity -> NonVoid a -> ShowS)
-> (NonVoid a -> String)
-> ([NonVoid a] -> ShowS)
-> Show (NonVoid a)
forall a. Show a => RepArity -> NonVoid a -> ShowS
forall a. Show a => [NonVoid a] -> ShowS
forall a. Show a => NonVoid a -> String
forall a.
(RepArity -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => RepArity -> NonVoid a -> ShowS
showsPrec :: RepArity -> NonVoid a -> ShowS
$cshow :: forall a. Show a => NonVoid a -> String
show :: NonVoid a -> String
$cshowList :: forall a. Show a => [NonVoid a] -> ShowS
showList :: [NonVoid a] -> ShowS
Show)
fromNonVoid :: NonVoid a -> a
fromNonVoid :: forall a. NonVoid a -> a
fromNonVoid (NonVoid a
a) = a
a
instance (Outputable a) => Outputable (NonVoid a) where
ppr :: NonVoid a -> SDoc
ppr (NonVoid a
a) = a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
a
nonVoidIds :: [Id] -> [NonVoid Id]
nonVoidIds :: [Id] -> [NonVoid Id]
nonVoidIds [Id]
ids = [Id -> NonVoid Id
forall a. a -> NonVoid a
NonVoid Id
id | Id
id <- [Id]
ids, Bool -> Bool
not ((() :: Constraint) => Type -> Bool
Type -> Bool
isZeroBitTy (Id -> Type
idType Id
id))]
assertNonVoidIds :: [Id] -> [NonVoid Id]
assertNonVoidIds :: [Id] -> [NonVoid Id]
assertNonVoidIds [Id]
ids = Bool -> [NonVoid Id] -> [NonVoid Id]
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not ((Id -> Bool) -> [Id] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((() :: Constraint) => Type -> Bool
Type -> Bool
isZeroBitTy (Type -> Bool) -> (Id -> Type) -> Id -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Type
idType) [Id]
ids)) ([NonVoid Id] -> [NonVoid Id]) -> [NonVoid Id] -> [NonVoid Id]
forall a b. (a -> b) -> a -> b
$
[Id] -> [NonVoid Id]
forall a b. Coercible a b => a -> b
coerce [Id]
ids
nonVoidStgArgs :: [StgArg] -> [NonVoid StgArg]
nonVoidStgArgs :: [StgArg] -> [NonVoid StgArg]
nonVoidStgArgs [StgArg]
args = [StgArg -> NonVoid StgArg
forall a. a -> NonVoid a
NonVoid StgArg
arg | StgArg
arg <- [StgArg]
args, Bool -> Bool
not ((() :: Constraint) => Type -> Bool
Type -> Bool
isZeroBitTy (StgArg -> Type
stgArgType StgArg
arg))]
assertNonVoidStgArgs :: [StgArg] -> [NonVoid StgArg]
assertNonVoidStgArgs :: [StgArg] -> [NonVoid StgArg]
assertNonVoidStgArgs [StgArg]
args = Bool -> [NonVoid StgArg] -> [NonVoid StgArg]
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not ((StgArg -> Bool) -> [StgArg] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((() :: Constraint) => Type -> Bool
Type -> Bool
isZeroBitTy (Type -> Bool) -> (StgArg -> Type) -> StgArg -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StgArg -> Type
stgArgType) [StgArg]
args)) ([NonVoid StgArg] -> [NonVoid StgArg])
-> [NonVoid StgArg] -> [NonVoid StgArg]
forall a b. (a -> b) -> a -> b
$
[StgArg] -> [NonVoid StgArg]
forall a b. Coercible a b => a -> b
coerce [StgArg]
args
idPrimRep :: Id -> PrimRep
idPrimRep :: Id -> PrimRep
idPrimRep Id
id = (() :: Constraint) => Type -> PrimRep
Type -> PrimRep
typePrimRep1 (Id -> Type
idType Id
id)
addIdReps :: [NonVoid Id] -> [NonVoid (PrimRep, Id)]
addIdReps :: [NonVoid Id] -> [NonVoid (PrimRep, Id)]
addIdReps = (NonVoid Id -> NonVoid (PrimRep, Id))
-> [NonVoid Id] -> [NonVoid (PrimRep, Id)]
forall a b. (a -> b) -> [a] -> [b]
map (\NonVoid Id
id -> let id' :: Id
id' = NonVoid Id -> Id
forall a. NonVoid a -> a
fromNonVoid NonVoid Id
id
in (PrimRep, Id) -> NonVoid (PrimRep, Id)
forall a. a -> NonVoid a
NonVoid (Id -> PrimRep
idPrimRep Id
id', Id
id'))
addArgReps :: [NonVoid StgArg] -> [NonVoid (PrimRep, StgArg)]
addArgReps :: [NonVoid StgArg] -> [NonVoid (PrimRep, StgArg)]
addArgReps = (NonVoid StgArg -> NonVoid (PrimRep, StgArg))
-> [NonVoid StgArg] -> [NonVoid (PrimRep, StgArg)]
forall a b. (a -> b) -> [a] -> [b]
map (\NonVoid StgArg
arg -> let arg' :: StgArg
arg' = NonVoid StgArg -> StgArg
forall a. NonVoid a -> a
fromNonVoid NonVoid StgArg
arg
in (PrimRep, StgArg) -> NonVoid (PrimRep, StgArg)
forall a. a -> NonVoid a
NonVoid (StgArg -> PrimRep
argPrimRep StgArg
arg', StgArg
arg'))
argPrimRep :: StgArg -> PrimRep
argPrimRep :: StgArg -> PrimRep
argPrimRep StgArg
arg = (() :: Constraint) => Type -> PrimRep
Type -> PrimRep
typePrimRep1 (StgArg -> Type
stgArgType StgArg
arg)
mkLFArgument :: Id -> LambdaFormInfo
mkLFArgument :: Id -> LambdaFormInfo
mkLFArgument Id
id
| (() :: Constraint) => Type -> Bool
Type -> Bool
isUnliftedType Type
ty = LambdaFormInfo
LFUnlifted
| Type -> Bool
mightBeFunTy Type
ty = Bool -> LambdaFormInfo
LFUnknown Bool
True
| Bool
otherwise = Bool -> LambdaFormInfo
LFUnknown Bool
False
where
ty :: Type
ty = Id -> Type
idType Id
id
mkLFLetNoEscape :: LambdaFormInfo
mkLFLetNoEscape :: LambdaFormInfo
mkLFLetNoEscape = LambdaFormInfo
LFLetNoEscape
mkLFReEntrant :: TopLevelFlag
-> [Id]
-> [Id]
-> ArgDescr
-> LambdaFormInfo
mkLFReEntrant :: TopLevelFlag -> [Id] -> [Id] -> ArgDescr -> LambdaFormInfo
mkLFReEntrant TopLevelFlag
_ [Id]
_ [] ArgDescr
_
= String -> SDoc -> LambdaFormInfo
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"mkLFReEntrant" SDoc
forall doc. IsOutput doc => doc
empty
mkLFReEntrant TopLevelFlag
top [Id]
fvs [Id]
args ArgDescr
arg_descr
= TopLevelFlag -> RepArity -> Bool -> ArgDescr -> LambdaFormInfo
LFReEntrant TopLevelFlag
top ([Id] -> RepArity
forall a. [a] -> RepArity
forall (t :: * -> *) a. Foldable t => t a -> RepArity
length [Id]
args) ([Id] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Id]
fvs) ArgDescr
arg_descr
mkLFThunk :: Type -> TopLevelFlag -> [Id] -> UpdateFlag -> LambdaFormInfo
mkLFThunk :: Type -> TopLevelFlag -> [Id] -> UpdateFlag -> LambdaFormInfo
mkLFThunk Type
thunk_ty TopLevelFlag
top [Id]
fvs UpdateFlag
upd_flag
= Bool -> LambdaFormInfo -> LambdaFormInfo
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (UpdateFlag -> Bool
isUpdatable UpdateFlag
upd_flag) Bool -> Bool -> Bool
|| Bool -> Bool
not ((() :: Constraint) => Type -> Bool
Type -> Bool
isUnliftedType Type
thunk_ty)) (LambdaFormInfo -> LambdaFormInfo)
-> LambdaFormInfo -> LambdaFormInfo
forall a b. (a -> b) -> a -> b
$
TopLevelFlag
-> Bool -> Bool -> StandardFormInfo -> Bool -> LambdaFormInfo
LFThunk TopLevelFlag
top ([Id] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Id]
fvs)
(UpdateFlag -> Bool
isUpdatable UpdateFlag
upd_flag)
StandardFormInfo
NonStandardThunk
(Type -> Bool
mightBeFunTy Type
thunk_ty)
mkConLFInfo :: DataCon -> LambdaFormInfo
mkConLFInfo :: DataCon -> LambdaFormInfo
mkConLFInfo DataCon
con = DataCon -> LambdaFormInfo
LFCon DataCon
con
mkSelectorLFInfo :: Id -> Int -> Bool -> LambdaFormInfo
mkSelectorLFInfo :: Id -> RepArity -> Bool -> LambdaFormInfo
mkSelectorLFInfo Id
id RepArity
offset Bool
updatable
= TopLevelFlag
-> Bool -> Bool -> StandardFormInfo -> Bool -> LambdaFormInfo
LFThunk TopLevelFlag
NotTopLevel Bool
False Bool
updatable (RepArity -> StandardFormInfo
SelectorThunk RepArity
offset)
(Type -> Bool
mightBeFunTy (Id -> Type
idType Id
id))
mkApLFInfo :: Id -> UpdateFlag -> Arity -> LambdaFormInfo
mkApLFInfo :: Id -> UpdateFlag -> RepArity -> LambdaFormInfo
mkApLFInfo Id
id UpdateFlag
upd_flag RepArity
arity
= TopLevelFlag
-> Bool -> Bool -> StandardFormInfo -> Bool -> LambdaFormInfo
LFThunk TopLevelFlag
NotTopLevel (RepArity
arity RepArity -> RepArity -> Bool
forall a. Eq a => a -> a -> Bool
== RepArity
0) (UpdateFlag -> Bool
isUpdatable UpdateFlag
upd_flag) (RepArity -> StandardFormInfo
ApThunk RepArity
arity)
(Type -> Bool
mightBeFunTy (Id -> Type
idType Id
id))
mkLFImported :: Id -> LambdaFormInfo
mkLFImported :: Id -> LambdaFormInfo
mkLFImported Id
id =
case Id -> Maybe LambdaFormInfo
idLFInfo_maybe Id
id of
Just LambdaFormInfo
lf_info ->
LambdaFormInfo
lf_info
Maybe LambdaFormInfo
Nothing
| RepArity
arity RepArity -> RepArity -> Bool
forall a. Ord a => a -> a -> Bool
> RepArity
0
-> TopLevelFlag -> RepArity -> Bool -> ArgDescr -> LambdaFormInfo
LFReEntrant TopLevelFlag
TopLevel RepArity
arity Bool
True ArgDescr
ArgUnknown
| Just DataCon
con <- Id -> Maybe DataCon
isDataConId_maybe Id
id
-> Bool -> LambdaFormInfo -> LambdaFormInfo
forall a. HasCallStack => Bool -> a -> a
assert (DataCon -> Bool
hasNoNonZeroWidthArgs DataCon
con) (LambdaFormInfo -> LambdaFormInfo)
-> LambdaFormInfo -> LambdaFormInfo
forall a b. (a -> b) -> a -> b
$
DataCon -> LambdaFormInfo
LFCon DataCon
con
| Bool
otherwise
-> Id -> LambdaFormInfo
mkLFArgument Id
id
where
arity :: RepArity
arity = Id -> RepArity
idFunRepArity Id
id
hasNoNonZeroWidthArgs :: DataCon -> Bool
hasNoNonZeroWidthArgs = (Scaled Type -> Bool) -> [Scaled Type] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((() :: Constraint) => Type -> Bool
Type -> Bool
isZeroBitTy (Type -> Bool) -> (Scaled Type -> Type) -> Scaled Type -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scaled Type -> Type
forall a. Scaled a -> a
scaledThing) ([Scaled Type] -> Bool)
-> (DataCon -> [Scaled Type]) -> DataCon -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataCon -> [Scaled Type]
dataConRepArgTys
mkLFStringLit :: LambdaFormInfo
mkLFStringLit :: LambdaFormInfo
mkLFStringLit = LambdaFormInfo
LFUnlifted
type DynTag = Int
isSmallFamily :: Platform -> Int -> Bool
isSmallFamily :: Platform -> RepArity -> Bool
isSmallFamily Platform
platform RepArity
fam_size = RepArity
fam_size RepArity -> RepArity -> Bool
forall a. Ord a => a -> a -> Bool
<= Platform -> RepArity
mAX_PTR_TAG Platform
platform
tagForCon :: Platform -> DataCon -> DynTag
tagForCon :: Platform -> DataCon -> RepArity
tagForCon Platform
platform DataCon
con = RepArity -> RepArity -> RepArity
forall a. Ord a => a -> a -> a
min (DataCon -> RepArity
dataConTag DataCon
con) (Platform -> RepArity
mAX_PTR_TAG Platform
platform)
tagForArity :: Platform -> RepArity -> DynTag
tagForArity :: Platform -> RepArity -> RepArity
tagForArity Platform
platform RepArity
arity
| Platform -> RepArity -> Bool
isSmallFamily Platform
platform RepArity
arity = RepArity
arity
| Bool
otherwise = RepArity
0
lfDynTag :: Platform -> LambdaFormInfo -> DynTag
lfDynTag :: Platform -> LambdaFormInfo -> RepArity
lfDynTag Platform
platform LambdaFormInfo
lf = case LambdaFormInfo
lf of
LFCon DataCon
con -> Platform -> DataCon -> RepArity
tagForCon Platform
platform DataCon
con
LFReEntrant TopLevelFlag
_ RepArity
arity Bool
_ ArgDescr
_ -> Platform -> RepArity -> RepArity
tagForArity Platform
platform RepArity
arity
LambdaFormInfo
_other -> RepArity
0
isLFThunk :: LambdaFormInfo -> Bool
isLFThunk :: LambdaFormInfo -> Bool
isLFThunk (LFThunk {}) = Bool
True
isLFThunk LambdaFormInfo
_ = Bool
False
isLFReEntrant :: LambdaFormInfo -> Bool
isLFReEntrant :: LambdaFormInfo -> Bool
isLFReEntrant (LFReEntrant {}) = Bool
True
isLFReEntrant LambdaFormInfo
_ = Bool
False
lfClosureType :: LambdaFormInfo -> ClosureTypeInfo
lfClosureType :: LambdaFormInfo -> ClosureTypeInfo
lfClosureType (LFReEntrant TopLevelFlag
_ RepArity
arity Bool
_ ArgDescr
argd) = RepArity -> ArgDescr -> ClosureTypeInfo
Fun RepArity
arity ArgDescr
argd
lfClosureType (LFCon DataCon
con) = RepArity -> ConstrDescription -> ClosureTypeInfo
Constr (DataCon -> RepArity
dataConTagZ DataCon
con)
(DataCon -> ConstrDescription
dataConIdentity DataCon
con)
lfClosureType (LFThunk TopLevelFlag
_ Bool
_ Bool
_ StandardFormInfo
is_sel Bool
_) = StandardFormInfo -> ClosureTypeInfo
thunkClosureType StandardFormInfo
is_sel
lfClosureType LambdaFormInfo
_ = String -> ClosureTypeInfo
forall a. HasCallStack => String -> a
panic String
"lfClosureType"
thunkClosureType :: StandardFormInfo -> ClosureTypeInfo
thunkClosureType :: StandardFormInfo -> ClosureTypeInfo
thunkClosureType (SelectorThunk RepArity
off) = RepArity -> ClosureTypeInfo
ThunkSelector RepArity
off
thunkClosureType StandardFormInfo
_ = ClosureTypeInfo
Thunk
nodeMustPointToIt :: Profile -> LambdaFormInfo -> Bool
nodeMustPointToIt :: Profile -> LambdaFormInfo -> Bool
nodeMustPointToIt Profile
_ (LFReEntrant TopLevelFlag
top RepArity
_ Bool
no_fvs ArgDescr
_)
= Bool -> Bool
not Bool
no_fvs
Bool -> Bool -> Bool
|| TopLevelFlag -> Bool
isNotTopLevel TopLevelFlag
top
nodeMustPointToIt Profile
profile (LFThunk TopLevelFlag
top Bool
no_fvs Bool
updatable StandardFormInfo
NonStandardThunk Bool
_)
= Bool -> Bool
not Bool
no_fvs
Bool -> Bool -> Bool
|| TopLevelFlag -> Bool
isNotTopLevel TopLevelFlag
top
Bool -> Bool -> Bool
|| Bool
updatable
Bool -> Bool -> Bool
|| Profile -> Bool
profileIsProfiling Profile
profile
nodeMustPointToIt Profile
_ (LFThunk {})
= Bool
True
nodeMustPointToIt Profile
_ (LFCon DataCon
_) = Bool
True
nodeMustPointToIt Profile
_ (LFUnknown Bool
_) = Bool
True
nodeMustPointToIt Profile
_ LambdaFormInfo
LFUnlifted = Bool
False
nodeMustPointToIt Profile
_ LambdaFormInfo
LFLetNoEscape = Bool
False
data CallMethod
= EnterIt
| JumpToIt BlockId [LocalReg]
| ReturnIt
| InferedReturnIt
| SlowCall
| DirectEntry
CLabel
RepArity
instance Outputable CallMethod where
ppr :: CallMethod -> SDoc
ppr (CallMethod
EnterIt) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Enter"
ppr (JumpToIt {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"JumpToIt"
ppr (CallMethod
ReturnIt ) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ReturnIt"
ppr (CallMethod
InferedReturnIt) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"InferedReturnIt"
ppr (CallMethod
SlowCall ) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"SlowCall"
ppr (DirectEntry {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"DirectEntry"
getCallMethod :: StgToCmmConfig
-> Name
-> Id
-> LambdaFormInfo
-> RepArity
-> CgLoc
-> Maybe SelfLoopInfo
-> CallMethod
getCallMethod :: StgToCmmConfig
-> Name
-> Id
-> LambdaFormInfo
-> RepArity
-> CgLoc
-> Maybe SelfLoopInfo
-> CallMethod
getCallMethod StgToCmmConfig
cfg Name
_ Id
id LambdaFormInfo
_ RepArity
n_args CgLoc
_cg_loc (Just SelfLoopInfo
self_loop)
| StgToCmmConfig -> Bool
stgToCmmLoopification StgToCmmConfig
cfg
, MkSelfLoopInfo
{ sli_id :: SelfLoopInfo -> Id
sli_id = Id
loop_id, sli_arity :: SelfLoopInfo -> RepArity
sli_arity = RepArity
arity
, sli_header_block :: SelfLoopInfo -> BlockId
sli_header_block = BlockId
blk_id, sli_registers :: SelfLoopInfo -> [LocalReg]
sli_registers = [LocalReg]
arg_regs
} <- SelfLoopInfo
self_loop
, Id
id Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Id
loop_id
, RepArity
n_args RepArity -> RepArity -> Bool
forall a. Eq a => a -> a -> Bool
== RepArity
arity
= BlockId -> [LocalReg] -> CallMethod
JumpToIt BlockId
blk_id [LocalReg]
arg_regs
getCallMethod StgToCmmConfig
cfg Name
name Id
id (LFReEntrant TopLevelFlag
_ RepArity
arity Bool
_ ArgDescr
_) RepArity
n_args CgLoc
_cg_loc Maybe SelfLoopInfo
_self_loop_info
| RepArity
n_args RepArity -> RepArity -> Bool
forall a. Eq a => a -> a -> Bool
== RepArity
0
Bool -> Bool -> Bool
&& Bool -> Bool
not (Profile -> Bool
profileIsProfiling (StgToCmmConfig -> Profile
stgToCmmProfile StgToCmmConfig
cfg))
= Bool -> CallMethod -> CallMethod
forall a. HasCallStack => Bool -> a -> a
assert (RepArity
arity RepArity -> RepArity -> Bool
forall a. Eq a => a -> a -> Bool
/= RepArity
0) CallMethod
ReturnIt
| RepArity
n_args RepArity -> RepArity -> Bool
forall a. Ord a => a -> a -> Bool
< RepArity
arity = CallMethod
SlowCall
| Bool
otherwise = CLabel -> RepArity -> CallMethod
DirectEntry (Platform -> Name -> CafInfo -> CLabel
enterIdLabel (StgToCmmConfig -> Platform
stgToCmmPlatform StgToCmmConfig
cfg) Name
name (Id -> CafInfo
idCafInfo Id
id)) RepArity
arity
getCallMethod StgToCmmConfig
_ Name
_name Id
_ LambdaFormInfo
LFUnlifted RepArity
n_args CgLoc
_cg_loc Maybe SelfLoopInfo
_self_loop_info
= Bool -> CallMethod -> CallMethod
forall a. HasCallStack => Bool -> a -> a
assert (RepArity
n_args RepArity -> RepArity -> Bool
forall a. Eq a => a -> a -> Bool
== RepArity
0) CallMethod
ReturnIt
getCallMethod StgToCmmConfig
_ Name
_name Id
_ (LFCon DataCon
_) RepArity
n_args CgLoc
_cg_loc Maybe SelfLoopInfo
_self_loop_info
= Bool -> CallMethod -> CallMethod
forall a. HasCallStack => Bool -> a -> a
assert (RepArity
n_args RepArity -> RepArity -> Bool
forall a. Eq a => a -> a -> Bool
== RepArity
0) CallMethod
ReturnIt
getCallMethod StgToCmmConfig
cfg Name
name Id
id (LFThunk TopLevelFlag
_ Bool
_ Bool
updatable StandardFormInfo
std_form_info Bool
is_fun)
RepArity
n_args CgLoc
_cg_loc Maybe SelfLoopInfo
_self_loop_info
| Just TagSig
sig <- Id -> Maybe TagSig
idTagSig_maybe Id
id
, TagSig -> Bool
isTaggedSig TagSig
sig
, RepArity
n_args RepArity -> RepArity -> Bool
forall a. Eq a => a -> a -> Bool
== RepArity
0
= CallMethod
InferedReturnIt
| Bool
is_fun
= CallMethod
SlowCall
| Bool
updatable Bool -> Bool -> Bool
|| StgToCmmConfig -> Bool
stgToCmmDoTicky StgToCmmConfig
cfg
= CallMethod
EnterIt
| SelectorThunk{} <- StandardFormInfo
std_form_info
= CallMethod
EnterIt
| Bool
otherwise
= Bool -> CallMethod -> CallMethod
forall a. HasCallStack => Bool -> a -> a
assert (RepArity
n_args RepArity -> RepArity -> Bool
forall a. Eq a => a -> a -> Bool
== RepArity
0) (CallMethod -> CallMethod) -> CallMethod -> CallMethod
forall a b. (a -> b) -> a -> b
$
CLabel -> RepArity -> CallMethod
DirectEntry (Platform -> Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel
thunkEntryLabel (StgToCmmConfig -> Platform
stgToCmmPlatform StgToCmmConfig
cfg) Name
name (Id -> CafInfo
idCafInfo Id
id) StandardFormInfo
std_form_info
Bool
updatable) RepArity
0
getCallMethod StgToCmmConfig
cfg Name
name Id
id (LFUnknown Bool
might_be_a_function) RepArity
n_args CgLoc
_cg_locs Maybe SelfLoopInfo
_self_loop_info
| RepArity
n_args RepArity -> RepArity -> Bool
forall a. Eq a => a -> a -> Bool
== RepArity
0
, Just TagSig
sig <- Id -> Maybe TagSig
idTagSig_maybe Id
id
, TagSig -> Bool
isTaggedSig TagSig
sig
, Bool -> Bool
not (Profile -> Bool
profileIsProfiling (StgToCmmConfig -> Profile
stgToCmmProfile StgToCmmConfig
cfg) Bool -> Bool -> Bool
&& Bool
might_be_a_function)
= CallMethod
InferedReturnIt
| Bool
might_be_a_function = CallMethod
SlowCall
| Bool
otherwise =
Bool -> SDoc -> CallMethod -> CallMethod
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr ( RepArity
n_args RepArity -> RepArity -> Bool
forall a. Eq a => a -> a -> Bool
== RepArity
0) ( Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RepArity -> SDoc
forall a. Outputable a => a -> SDoc
ppr RepArity
n_args )
CallMethod
EnterIt
getCallMethod StgToCmmConfig
_ Name
_name Id
_ LambdaFormInfo
LFLetNoEscape RepArity
_n_args (LneLoc BlockId
blk_id [LocalReg]
lne_regs) Maybe SelfLoopInfo
_self_loop_info
= BlockId -> [LocalReg] -> CallMethod
JumpToIt BlockId
blk_id [LocalReg]
lne_regs
getCallMethod StgToCmmConfig
_ Name
_ Id
_ LambdaFormInfo
_ RepArity
_ CgLoc
_ Maybe SelfLoopInfo
_ = String -> CallMethod
forall a. HasCallStack => String -> a
panic String
"Unknown call method"
data ClosureInfo
= ClosureInfo {
ClosureInfo -> Id
closureName :: !Id,
ClosureInfo -> LambdaFormInfo
closureLFInfo :: !LambdaFormInfo,
ClosureInfo -> CLabel
closureInfoLabel :: !CLabel,
ClosureInfo -> SMRep
closureSMRep :: !SMRep,
ClosureInfo -> ProfilingInfo
closureProf :: !ProfilingInfo
}
mkCmmInfo :: ClosureInfo -> Id -> CostCentreStack -> CmmInfoTable
mkCmmInfo :: ClosureInfo -> Id -> CostCentreStack -> CmmInfoTable
mkCmmInfo ClosureInfo {Id
CLabel
SMRep
LambdaFormInfo
ProfilingInfo
closureLFInfo :: ClosureInfo -> LambdaFormInfo
closureName :: ClosureInfo -> Id
closureInfoLabel :: ClosureInfo -> CLabel
closureSMRep :: ClosureInfo -> SMRep
closureProf :: ClosureInfo -> ProfilingInfo
closureName :: Id
closureLFInfo :: LambdaFormInfo
closureInfoLabel :: CLabel
closureSMRep :: SMRep
closureProf :: ProfilingInfo
..} Id
id CostCentreStack
ccs
= CmmInfoTable { cit_lbl :: CLabel
cit_lbl = CLabel
closureInfoLabel
, cit_rep :: SMRep
cit_rep = SMRep
closureSMRep
, cit_prof :: ProfilingInfo
cit_prof = ProfilingInfo
closureProf
, cit_srt :: Maybe CLabel
cit_srt = Maybe CLabel
forall a. Maybe a
Nothing
, cit_clo :: Maybe (Id, CostCentreStack)
cit_clo = if SMRep -> Bool
isStaticRep SMRep
closureSMRep
then (Id, CostCentreStack) -> Maybe (Id, CostCentreStack)
forall a. a -> Maybe a
Just (Id
id,CostCentreStack
ccs)
else Maybe (Id, CostCentreStack)
forall a. Maybe a
Nothing }
mkClosureInfo :: Profile
-> Bool
-> Id
-> LambdaFormInfo
-> Int -> Int
-> String
-> ClosureInfo
mkClosureInfo :: Profile
-> Bool
-> Id
-> LambdaFormInfo
-> RepArity
-> RepArity
-> String
-> ClosureInfo
mkClosureInfo Profile
profile Bool
is_static Id
id LambdaFormInfo
lf_info RepArity
tot_wds RepArity
ptr_wds String
val_descr
= ClosureInfo { closureName :: Id
closureName = Id
id
, closureLFInfo :: LambdaFormInfo
closureLFInfo = LambdaFormInfo
lf_info
, closureInfoLabel :: CLabel
closureInfoLabel = CLabel
info_lbl
, closureSMRep :: SMRep
closureSMRep = SMRep
sm_rep
, closureProf :: ProfilingInfo
closureProf = ProfilingInfo
prof }
where
sm_rep :: SMRep
sm_rep = Profile -> Bool -> RepArity -> RepArity -> ClosureTypeInfo -> SMRep
mkHeapRep Profile
profile Bool
is_static RepArity
ptr_wds RepArity
nonptr_wds (LambdaFormInfo -> ClosureTypeInfo
lfClosureType LambdaFormInfo
lf_info)
prof :: ProfilingInfo
prof = Profile -> Id -> String -> ProfilingInfo
mkProfilingInfo Profile
profile Id
id String
val_descr
nonptr_wds :: RepArity
nonptr_wds = RepArity
tot_wds RepArity -> RepArity -> RepArity
forall a. Num a => a -> a -> a
- RepArity
ptr_wds
info_lbl :: CLabel
info_lbl = Platform -> Id -> LambdaFormInfo -> CLabel
mkClosureInfoTableLabel (Profile -> Platform
profilePlatform Profile
profile) Id
id LambdaFormInfo
lf_info
blackHoleOnEntry :: ClosureInfo -> Bool
blackHoleOnEntry :: ClosureInfo -> Bool
blackHoleOnEntry ClosureInfo
cl_info
| SMRep -> Bool
isStaticRep (ClosureInfo -> SMRep
closureSMRep ClosureInfo
cl_info)
= Bool
False
| Bool
otherwise
= case ClosureInfo -> LambdaFormInfo
closureLFInfo ClosureInfo
cl_info of
LFReEntrant {} -> Bool
False
LambdaFormInfo
LFLetNoEscape -> Bool
False
LFThunk TopLevelFlag
_ Bool
_no_fvs Bool
upd StandardFormInfo
_ Bool
_ -> Bool
upd
LambdaFormInfo
_other -> String -> Bool
forall a. HasCallStack => String -> a
panic String
"blackHoleOnEntry"
isStaticClosure :: ClosureInfo -> Bool
isStaticClosure :: ClosureInfo -> Bool
isStaticClosure ClosureInfo
cl_info = SMRep -> Bool
isStaticRep (ClosureInfo -> SMRep
closureSMRep ClosureInfo
cl_info)
closureUpdReqd :: ClosureInfo -> Bool
closureUpdReqd :: ClosureInfo -> Bool
closureUpdReqd ClosureInfo{ closureLFInfo :: ClosureInfo -> LambdaFormInfo
closureLFInfo = LambdaFormInfo
lf_info } = LambdaFormInfo -> Bool
lfUpdatable LambdaFormInfo
lf_info
lfUpdatable :: LambdaFormInfo -> Bool
lfUpdatable :: LambdaFormInfo -> Bool
lfUpdatable (LFThunk TopLevelFlag
_ Bool
_ Bool
upd StandardFormInfo
_ Bool
_) = Bool
upd
lfUpdatable LambdaFormInfo
_ = Bool
False
closureReEntrant :: ClosureInfo -> Bool
closureReEntrant :: ClosureInfo -> Bool
closureReEntrant (ClosureInfo { closureLFInfo :: ClosureInfo -> LambdaFormInfo
closureLFInfo = LFReEntrant {} }) = Bool
True
closureReEntrant ClosureInfo
_ = Bool
False
closureFunInfo :: ClosureInfo -> Maybe (RepArity, ArgDescr)
closureFunInfo :: ClosureInfo -> Maybe (RepArity, ArgDescr)
closureFunInfo (ClosureInfo { closureLFInfo :: ClosureInfo -> LambdaFormInfo
closureLFInfo = LambdaFormInfo
lf_info }) = LambdaFormInfo -> Maybe (RepArity, ArgDescr)
lfFunInfo LambdaFormInfo
lf_info
lfFunInfo :: LambdaFormInfo -> Maybe (RepArity, ArgDescr)
lfFunInfo :: LambdaFormInfo -> Maybe (RepArity, ArgDescr)
lfFunInfo (LFReEntrant TopLevelFlag
_ RepArity
arity Bool
_ ArgDescr
arg_desc) = (RepArity, ArgDescr) -> Maybe (RepArity, ArgDescr)
forall a. a -> Maybe a
Just (RepArity
arity, ArgDescr
arg_desc)
lfFunInfo LambdaFormInfo
_ = Maybe (RepArity, ArgDescr)
forall a. Maybe a
Nothing
funTag :: Platform -> ClosureInfo -> DynTag
funTag :: Platform -> ClosureInfo -> RepArity
funTag Platform
platform (ClosureInfo { closureLFInfo :: ClosureInfo -> LambdaFormInfo
closureLFInfo = LambdaFormInfo
lf_info })
= Platform -> LambdaFormInfo -> RepArity
lfDynTag Platform
platform LambdaFormInfo
lf_info
isToplevClosure :: ClosureInfo -> Bool
isToplevClosure :: ClosureInfo -> Bool
isToplevClosure (ClosureInfo { closureLFInfo :: ClosureInfo -> LambdaFormInfo
closureLFInfo = LambdaFormInfo
lf_info })
= case LambdaFormInfo
lf_info of
LFReEntrant TopLevelFlag
TopLevel RepArity
_ Bool
_ ArgDescr
_ -> Bool
True
LFThunk TopLevelFlag
TopLevel Bool
_ Bool
_ StandardFormInfo
_ Bool
_ -> Bool
True
LambdaFormInfo
_other -> Bool
False
staticClosureLabel :: Platform -> ClosureInfo -> CLabel
staticClosureLabel :: Platform -> ClosureInfo -> CLabel
staticClosureLabel Platform
platform = Platform -> CLabel -> CLabel
toClosureLbl Platform
platform (CLabel -> CLabel)
-> (ClosureInfo -> CLabel) -> ClosureInfo -> CLabel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClosureInfo -> CLabel
closureInfoLabel
closureSlowEntryLabel :: Platform -> ClosureInfo -> CLabel
closureSlowEntryLabel :: Platform -> ClosureInfo -> CLabel
closureSlowEntryLabel Platform
platform = Platform -> CLabel -> CLabel
toSlowEntryLbl Platform
platform (CLabel -> CLabel)
-> (ClosureInfo -> CLabel) -> ClosureInfo -> CLabel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClosureInfo -> CLabel
closureInfoLabel
closureLocalEntryLabel :: Platform -> ClosureInfo -> CLabel
closureLocalEntryLabel :: Platform -> ClosureInfo -> CLabel
closureLocalEntryLabel Platform
platform
| Platform -> Bool
platformTablesNextToCode Platform
platform = Platform -> CLabel -> CLabel
toInfoLbl Platform
platform (CLabel -> CLabel)
-> (ClosureInfo -> CLabel) -> ClosureInfo -> CLabel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClosureInfo -> CLabel
closureInfoLabel
| Bool
otherwise = Platform -> CLabel -> CLabel
toEntryLbl Platform
platform (CLabel -> CLabel)
-> (ClosureInfo -> CLabel) -> ClosureInfo -> CLabel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClosureInfo -> CLabel
closureInfoLabel
mkClosureInfoTableLabel :: Platform -> Id -> LambdaFormInfo -> CLabel
mkClosureInfoTableLabel :: Platform -> Id -> LambdaFormInfo -> CLabel
mkClosureInfoTableLabel Platform
platform Id
id LambdaFormInfo
lf_info
= case LambdaFormInfo
lf_info of
LFThunk TopLevelFlag
_ Bool
_ Bool
upd_flag (SelectorThunk RepArity
offset) Bool
_
-> Platform -> Bool -> RepArity -> CLabel
mkSelectorInfoLabel Platform
platform Bool
upd_flag RepArity
offset
LFThunk TopLevelFlag
_ Bool
_ Bool
upd_flag (ApThunk RepArity
arity) Bool
_
-> Platform -> Bool -> RepArity -> CLabel
mkApInfoTableLabel Platform
platform Bool
upd_flag RepArity
arity
LFThunk{} -> Name -> CafInfo -> CLabel
mkInfoTableLabel Name
name CafInfo
cafs
LFReEntrant{} -> Name -> CafInfo -> CLabel
mkInfoTableLabel Name
name CafInfo
cafs
LambdaFormInfo
_other -> String -> CLabel
forall a. HasCallStack => String -> a
panic String
"closureInfoTableLabel"
where
name :: Name
name = Id -> Name
idName Id
id
cafs :: CafInfo
cafs = Id -> CafInfo
idCafInfo Id
id
thunkEntryLabel :: Platform -> Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel
thunkEntryLabel :: Platform -> Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel
thunkEntryLabel Platform
platform Name
thunk_id CafInfo
caf_info StandardFormInfo
sfi Bool
upd_flag = case StandardFormInfo
sfi of
ApThunk RepArity
arity -> Platform -> Bool -> RepArity -> CLabel
enterApLabel Platform
platform Bool
upd_flag RepArity
arity
SelectorThunk RepArity
offset -> Platform -> Bool -> RepArity -> CLabel
enterSelectorLabel Platform
platform Bool
upd_flag RepArity
offset
StandardFormInfo
_ -> Platform -> Name -> CafInfo -> CLabel
enterIdLabel Platform
platform Name
thunk_id CafInfo
caf_info
enterApLabel :: Platform -> Bool -> Arity -> CLabel
enterApLabel :: Platform -> Bool -> RepArity -> CLabel
enterApLabel Platform
platform Bool
is_updatable RepArity
arity
| Platform -> Bool
platformTablesNextToCode Platform
platform = Platform -> Bool -> RepArity -> CLabel
mkApInfoTableLabel Platform
platform Bool
is_updatable RepArity
arity
| Bool
otherwise = Platform -> Bool -> RepArity -> CLabel
mkApEntryLabel Platform
platform Bool
is_updatable RepArity
arity
enterSelectorLabel :: Platform -> Bool -> WordOff -> CLabel
enterSelectorLabel :: Platform -> Bool -> RepArity -> CLabel
enterSelectorLabel Platform
platform Bool
upd_flag RepArity
offset
| Platform -> Bool
platformTablesNextToCode Platform
platform = Platform -> Bool -> RepArity -> CLabel
mkSelectorInfoLabel Platform
platform Bool
upd_flag RepArity
offset
| Bool
otherwise = Platform -> Bool -> RepArity -> CLabel
mkSelectorEntryLabel Platform
platform Bool
upd_flag RepArity
offset
enterIdLabel :: Platform -> Name -> CafInfo -> CLabel
enterIdLabel :: Platform -> Name -> CafInfo -> CLabel
enterIdLabel Platform
platform Name
id CafInfo
c
| Platform -> Bool
platformTablesNextToCode Platform
platform = Name -> CafInfo -> CLabel
mkInfoTableLabel Name
id CafInfo
c
| Bool
otherwise = Name -> CafInfo -> CLabel
mkEntryLabel Name
id CafInfo
c
mkProfilingInfo :: Profile -> Id -> String -> ProfilingInfo
mkProfilingInfo :: Profile -> Id -> String -> ProfilingInfo
mkProfilingInfo Profile
profile Id
id String
val_descr
| Bool -> Bool
not (Profile -> Bool
profileIsProfiling Profile
profile) = ProfilingInfo
NoProfilingInfo
| Bool
otherwise = ConstrDescription -> ConstrDescription -> ProfilingInfo
ProfilingInfo ConstrDescription
ty_descr_w8 (String -> ConstrDescription
BS8.pack String
val_descr)
where
ty_descr_w8 :: ConstrDescription
ty_descr_w8 = String -> ConstrDescription
BS8.pack (Type -> String
getTyDescription (Id -> Type
idType Id
id))
getTyDescription :: Type -> String
getTyDescription :: Type -> String
getTyDescription Type
ty
= case (Type -> ([Id], ThetaType, Type)
tcSplitSigmaTy Type
ty) of { ([Id]
_, ThetaType
_, Type
tau_ty) ->
case Type
tau_ty of
TyVarTy Id
_ -> String
"*"
AppTy Type
fun Type
_ -> Type -> String
getTyDescription Type
fun
TyConApp TyCon
tycon ThetaType
_ -> TyCon -> String
forall a. NamedThing a => a -> String
getOccString TyCon
tycon
FunTy {} -> Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Type -> String
fun_result Type
tau_ty
ForAllTy ForAllTyBinder
_ Type
ty -> Type -> String
getTyDescription Type
ty
LitTy TyLit
n -> TyLit -> String
getTyLitDescription TyLit
n
CastTy Type
ty Coercion
_ -> Type -> String
getTyDescription Type
ty
CoercionTy Coercion
co -> String -> SDoc -> String
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getTyDescription" (Coercion -> SDoc
forall a. Outputable a => a -> SDoc
ppr Coercion
co)
}
where
fun_result :: Type -> String
fun_result (FunTy { ft_res :: Type -> Type
ft_res = Type
res }) = Char
'>' Char -> ShowS
forall a. a -> [a] -> [a]
: Type -> String
fun_result Type
res
fun_result Type
other = Type -> String
getTyDescription Type
other
getTyLitDescription :: TyLit -> String
getTyLitDescription :: TyLit -> String
getTyLitDescription TyLit
l =
case TyLit
l of
NumTyLit Integer
n -> Integer -> String
forall a. Show a => a -> String
show Integer
n
StrTyLit FastString
n -> FastString -> String
forall a. Show a => a -> String
show FastString
n
CharTyLit Char
n -> Char -> String
forall a. Show a => a -> String
show Char
n
mkDataConInfoTable :: Profile -> DataCon -> ConInfoTableLocation -> Bool -> Int -> Int -> CmmInfoTable
mkDataConInfoTable :: Profile
-> DataCon
-> ConInfoTableLocation
-> Bool
-> RepArity
-> RepArity
-> CmmInfoTable
mkDataConInfoTable Profile
profile DataCon
data_con ConInfoTableLocation
mn Bool
is_static RepArity
ptr_wds RepArity
nonptr_wds
= CmmInfoTable { cit_lbl :: CLabel
cit_lbl = CLabel
info_lbl
, cit_rep :: SMRep
cit_rep = SMRep
sm_rep
, cit_prof :: ProfilingInfo
cit_prof = ProfilingInfo
prof
, cit_srt :: Maybe CLabel
cit_srt = Maybe CLabel
forall a. Maybe a
Nothing
, cit_clo :: Maybe (Id, CostCentreStack)
cit_clo = Maybe (Id, CostCentreStack)
forall a. Maybe a
Nothing }
where
name :: Name
name = DataCon -> Name
dataConName DataCon
data_con
info_lbl :: CLabel
info_lbl = Name -> ConInfoTableLocation -> CLabel
mkConInfoTableLabel Name
name ConInfoTableLocation
mn
sm_rep :: SMRep
sm_rep = Profile -> Bool -> RepArity -> RepArity -> ClosureTypeInfo -> SMRep
mkHeapRep Profile
profile Bool
is_static RepArity
ptr_wds RepArity
nonptr_wds ClosureTypeInfo
cl_type
cl_type :: ClosureTypeInfo
cl_type = RepArity -> ConstrDescription -> ClosureTypeInfo
Constr (DataCon -> RepArity
dataConTagZ DataCon
data_con) (DataCon -> ConstrDescription
dataConIdentity DataCon
data_con)
prof :: ProfilingInfo
prof | Bool -> Bool
not (Profile -> Bool
profileIsProfiling Profile
profile) = ProfilingInfo
NoProfilingInfo
| Bool
otherwise = ConstrDescription -> ConstrDescription -> ProfilingInfo
ProfilingInfo ConstrDescription
ty_descr ConstrDescription
val_descr
ty_descr :: ConstrDescription
ty_descr = String -> ConstrDescription
BS8.pack (String -> ConstrDescription) -> String -> ConstrDescription
forall a b. (a -> b) -> a -> b
$ OccName -> String
occNameString (OccName -> String) -> OccName -> String
forall a b. (a -> b) -> a -> b
$ TyCon -> OccName
forall a. NamedThing a => a -> OccName
getOccName (TyCon -> OccName) -> TyCon -> OccName
forall a b. (a -> b) -> a -> b
$ DataCon -> TyCon
dataConTyCon DataCon
data_con
val_descr :: ConstrDescription
val_descr = String -> ConstrDescription
BS8.pack (String -> ConstrDescription) -> String -> ConstrDescription
forall a b. (a -> b) -> a -> b
$ OccName -> String
occNameString (OccName -> String) -> OccName -> String
forall a b. (a -> b) -> a -> b
$ DataCon -> OccName
forall a. NamedThing a => a -> OccName
getOccName DataCon
data_con
cafBlackHoleInfoTable :: CmmInfoTable
cafBlackHoleInfoTable :: CmmInfoTable
cafBlackHoleInfoTable
= CmmInfoTable { cit_lbl :: CLabel
cit_lbl = CLabel
mkCAFBlackHoleInfoTableLabel
, cit_rep :: SMRep
cit_rep = SMRep
blackHoleRep
, cit_prof :: ProfilingInfo
cit_prof = ProfilingInfo
NoProfilingInfo
, cit_srt :: Maybe CLabel
cit_srt = Maybe CLabel
forall a. Maybe a
Nothing
, cit_clo :: Maybe (Id, CostCentreStack)
cit_clo = Maybe (Id, CostCentreStack)
forall a. Maybe a
Nothing }
indStaticInfoTable :: CmmInfoTable
indStaticInfoTable :: CmmInfoTable
indStaticInfoTable
= CmmInfoTable { cit_lbl :: CLabel
cit_lbl = CLabel
mkIndStaticInfoLabel
, cit_rep :: SMRep
cit_rep = SMRep
indStaticRep
, cit_prof :: ProfilingInfo
cit_prof = ProfilingInfo
NoProfilingInfo
, cit_srt :: Maybe CLabel
cit_srt = Maybe CLabel
forall a. Maybe a
Nothing
, cit_clo :: Maybe (Id, CostCentreStack)
cit_clo = Maybe (Id, CostCentreStack)
forall a. Maybe a
Nothing }
staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool
staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool
staticClosureNeedsLink Bool
has_srt CmmInfoTable{ cit_rep :: CmmInfoTable -> SMRep
cit_rep = SMRep
smrep }
| SMRep -> Bool
isConRep SMRep
smrep = Bool -> Bool
not (SMRep -> Bool
isStaticNoCafCon SMRep
smrep)
| Bool
otherwise = Bool
has_srt