    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE LambdaCase #-}

    -----------------------------------------------------------------------------
    --
    -- Stg to C-- code generation
    --
    -- (c) The University of Glasgow 2004-2006
    --
    -----------------------------------------------------------------------------

    module GHC.StgToCmm ( codeGen ) where

    import GHC.Prelude as Prelude

    import GHC.Cmm.UniqueRenamer
    import GHC.StgToCmm.Prof (initCostCentres, ldvEnter)
    import GHC.StgToCmm.Monad
    import GHC.StgToCmm.Env
    import GHC.StgToCmm.Bind
    import GHC.StgToCmm.DataCon
    import GHC.StgToCmm.Layout
    import GHC.StgToCmm.Utils
    import GHC.StgToCmm.Closure
    import GHC.StgToCmm.Config
    import GHC.StgToCmm.Ticky
    import GHC.StgToCmm.Types (ModuleLFInfos)
    import GHC.StgToCmm.CgUtils (CgStream)

    import GHC.Cmm
    import GHC.Cmm.Utils
    import GHC.Cmm.CLabel
    import GHC.Cmm.Graph

    import GHC.Stg.Syntax

    import GHC.Types.CostCentre
    import GHC.Types.IPE
    import GHC.Types.Id
    import GHC.Types.Id.Info
    import GHC.Types.RepType
    import GHC.Types.Basic
    import GHC.Types.Var.Set ( isEmptyDVarSet )
    import GHC.Types.Unique.DFM
    import GHC.Types.Unique.FM
    import GHC.Types.Name.Env

    import GHC.Core.DataCon
    import GHC.Core.TyCon
    import GHC.Core.Multiplicity

    import GHC.Utils.Error
    import GHC.Utils.Outputable
    import GHC.Utils.Logger

    import GHC.Utils.TmpFs

    import GHC.Data.Stream
    import GHC.Data.OrdList

    import Control.Monad (when,void, forM_)
    import GHC.Utils.Misc
    import System.IO.Unsafe
    import qualified Data.ByteString as BS
    import Data.IORef
    import GHC.Utils.Panic

    codeGen :: Logger
            -> TmpFs
            -> StgToCmmConfig
            -> InfoTableProvMap
            -> [TyCon]
            -> CollectedCCs                -- (Local/global) cost-centres needing declaring/registering.
            -> [CgStgTopBinding]           -- Bindings to convert
            -> CgStream CmmGroup (ModuleLFInfos, DetUniqFM) -- See Note [Deterministic Uniques in the CG] on CgStream
                                           -- Output as a stream, so codegen can
                                           -- be interleaved with output

    codeGen :: Logger
    -> TmpFs
    -> StgToCmmConfig
    -> InfoTableProvMap
    -> [TyCon]
    -> CollectedCCs
    -> [CgStgTopBinding]
    -> CgStream CmmGroup (ModuleLFInfos, DetUniqFM)
    codeGen Logger
    logger TmpFs
    tmpfs StgToCmmConfig
    cfg (InfoTableProvMap DCMap
    denv ClosureMap
    _ InfoTableToSourceLocationMap
    _) [TyCon]
    tycons
            CollectedCCs
    cost_centre_info [CgStgTopBinding]
    stg_binds
      = do  {     -- cg: run the code generator, and yield the resulting CmmGroup
                  -- Using an IORef to store the state is a bit crude, but otherwise
                  -- we would need to add a state monad layer which regresses
                  -- allocations by 0.5-2%.
            ; cgref <- IO (IORef CgState) -> Stream (UniqDSMT IO) CmmGroup (IORef CgState)
    forall a. IO a -> Stream (UniqDSMT IO) CmmGroup a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (IORef CgState)
     -> Stream (UniqDSMT IO) CmmGroup (IORef CgState))
    -> IO (IORef CgState)
    -> Stream (UniqDSMT IO) CmmGroup (IORef CgState)
    forall a b. (a -> b) -> a -> b
    $ IO CgState
    initC IO CgState -> (CgState -> IO (IORef CgState)) -> IO (IORef CgState)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \CgState
    s -> CgState -> IO (IORef CgState)
    forall a. a -> IO (IORef a)
    newIORef CgState
    s
            ; uniqRnRef <- liftIO $ newIORef emptyDetUFM
            ; let fstate = Platform -> FCodeState
    initFCodeState (Platform -> FCodeState) -> Platform -> FCodeState
    forall a b. (a -> b) -> a -> b
    $ StgToCmmConfig -> Platform
    stgToCmmPlatform StgToCmmConfig
    cfg
            ; let cg :: FCode a -> CgStream CmmGroup a
                  cg FCode a
    fcode = do
                    (a, cmm) <- IO (a, CmmGroup) -> Stream (UniqDSMT IO) CmmGroup (a, CmmGroup)
    forall a. IO a -> Stream (UniqDSMT IO) CmmGroup a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (a, CmmGroup) -> Stream (UniqDSMT IO) CmmGroup (a, CmmGroup))
    -> (IO (a, CmmGroup) -> IO (a, CmmGroup))
    -> IO (a, CmmGroup)
    -> Stream (UniqDSMT IO) CmmGroup (a, CmmGroup)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Logger
    -> SDoc
    -> ((a, CmmGroup) -> ())
    -> IO (a, CmmGroup)
    -> IO (a, CmmGroup)
    forall (m :: * -> *) a.
    MonadIO m =>
    Logger -> SDoc -> (a -> ()) -> m a -> m a
    withTimingSilent Logger
    logger (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "STG -> Cmm") ((a, CmmGroup) -> () -> ()
    forall a b. a -> b -> b
    `seq` ()) (IO (a, CmmGroup) -> Stream (UniqDSMT IO) CmmGroup (a, CmmGroup))
    -> IO (a, CmmGroup) -> Stream (UniqDSMT IO) CmmGroup (a, CmmGroup)
    forall a b. (a -> b) -> a -> b
    $ do
                             st <- IORef CgState -> IO CgState
    forall a. IORef a -> IO a
    readIORef IORef CgState
    cgref

                             rnm0 <- readIORef uniqRnRef

                             let
                               ((a, cmm), st') = runC cfg fstate st (getCmm fcode)
                               (rnm1, cmm_renamed) =
                                 -- Enable deterministic object code generation by
                                 -- renaming uniques deterministically.
                                 -- See Note [Object determinism]
                                 if stgToCmmObjectDeterminism cfg
                                    then detRenameCmmGroup rnm0 cmm -- The yielded cmm will already be renamed.
                                    else (rnm0, removeDeterm cmm)

                             -- NB. stub-out cgs_tops and cgs_stmts.  This fixes
                             -- a big space leak.  DO NOT REMOVE!
                             -- This is observed by the #3294 test
                             writeIORef cgref $! (st'{ cgs_tops = nilOL, cgs_stmts = mkNop })
                             writeIORef uniqRnRef $! rnm1

                             return (a, cmm_renamed)
                    yield cmm
                    return a

            ; cg (mkModuleInit cost_centre_info)

            ; mapM_ (cg . cgTopBinding logger tmpfs cfg) stg_binds
                    -- Put datatype_stuff (cgTyCon) after code_stuff (cgTopBinding), because the
                    -- datatype closure table (for enumeration types) to
                    -- (say) PrelBase_True_closure, which is defined in
                    -- code_stuff

            ; mapM_ (cg . cgTyCon) tycons

            -- Emit special info tables for everything used in this module
            -- This will only do something if  `-fdistinct-info-tables` is turned on.
            ; mapM_ (\(DataCon
    dc, NonEmpty (WordOff, Maybe IpeSourceLocation)
    ns) -> NonEmpty (WordOff, Maybe IpeSourceLocation)
    -> ((WordOff, Maybe IpeSourceLocation)
        -> Stream (UniqDSMT IO) CmmGroup ())
    -> Stream (UniqDSMT IO) CmmGroup ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ NonEmpty (WordOff, Maybe IpeSourceLocation)
    ns (((WordOff, Maybe IpeSourceLocation)
      -> Stream (UniqDSMT IO) CmmGroup ())
     -> Stream (UniqDSMT IO) CmmGroup ())
    -> ((WordOff, Maybe IpeSourceLocation)
        -> Stream (UniqDSMT IO) CmmGroup ())
    -> Stream (UniqDSMT IO) CmmGroup ()
    forall a b. (a -> b) -> a -> b
    $ \(WordOff
    k, Maybe IpeSourceLocation
    _ss) -> FCode () -> Stream (UniqDSMT IO) CmmGroup ()
    forall a. FCode a -> CgStream CmmGroup a
    cg (ConInfoTableLocation -> DataCon -> FCode ()
    cgDataCon (Module -> WordOff -> ConInfoTableLocation
    UsageSite (StgToCmmConfig -> Module
    stgToCmmThisModule StgToCmmConfig
    cfg) WordOff
    k) DataCon
    dc)) (eltsUDFM denv)

            ; final_state <- liftIO (readIORef cgref)
            ; let cg_id_infos = CgState -> CgBindings
    cgs_binds CgState
    final_state

              -- See Note [Conveying CAF-info and LFInfo between modules] in
              -- GHC.StgToCmm.Types
            ; let extractInfo CgIdInfo
    info = (Name
    name, LambdaFormInfo
    lf)
                    where
                      !name :: Name
    name = Var -> Name
    idName (CgIdInfo -> Var
    cg_id CgIdInfo
    info)
                      !lf :: LambdaFormInfo
    lf = CgIdInfo -> LambdaFormInfo
    cg_lf CgIdInfo
    info

                  !generatedInfo
                    | StgToCmmConfig -> Bool
    stgToCmmOmitIfPragmas StgToCmmConfig
    cfg
                    = ModuleLFInfos
    forall a. NameEnv a
    emptyNameEnv
                    | Bool
    otherwise
                    = [(Name, LambdaFormInfo)] -> ModuleLFInfos
    forall a. [(Name, a)] -> NameEnv a
    mkNameEnv ((CgIdInfo -> (Name, LambdaFormInfo))
    -> [CgIdInfo] -> [(Name, LambdaFormInfo)]
    forall a b. (a -> b) -> [a] -> [b]
    Prelude.map CgIdInfo -> (Name, LambdaFormInfo)
    extractInfo (CgBindings -> [CgIdInfo]
    forall {k} (key :: k) elt. UniqFM key elt -> [elt]
    nonDetEltsUFM CgBindings
    cg_id_infos))

            ; rn_mapping <- liftIO (readIORef uniqRnRef)
            ; liftIO $ debugTraceMsg logger 3 (text "DetRnM mapping:" <+> ppr rn_mapping)

            ; return (generatedInfo, rn_mapping)
            }

    {-
    Note [Object determinism]
    ~~~~~~~~~~~~~~~~~~~~~~~~~
    Object determinism means that GHC, for the same exact input, produces,
    deterministically, byte-for-byte identical objects (.o files, executables,
    libraries...) on separate multi-threaded runs.

    Deterministic objects are critical, for instance, for reproducible software
    packaging and distribution, or build systems with content-sensitive
    recompilation avoidance.

    The main cause of non-determinism in objects comes from the non-deterministic
    uniques leaking into the generated code. Apart from uniques previously affecting
    determinism both directly by showing up in symbol labels and indirectly, e.g. in
    the CLabel Ord instance, GHC already did a lot deterministically (modulo bugs)
    by the time we set out to achieve full object determinism:

    * The Simplifier is deterministic in the optimisations it applies (c.f. #25170)

    * Interface files are deterministic (which depends on the previous bullet)

    * The Cmm/NCG pipeline processes sections in a deterministic order, so the final
      object sections, closures, data, etc., are already always outputted in the
      same order for the same module.

    Beyond fixing small bugs in the above bullets and other smaller non-determinism
    leaks like the Ord instance of CLabels, we must ensure that/do the following to
    make GHC produce fully deterministic objects:

    * In STG -> Cmm, deterministically /rename/ all non-external uniques in the Cmm
      chunk, deterministically, before yielding. See Note [Renaming uniques deterministically]
      in GHC.Cmm.UniqueRenamer. This pass is necessary for object determinism but
      is currently guarded by -fobject-determinism.

    * Multiple Cmm passes work with non-deterministic @LabelMap@s -- that doesn't
      change since they are both important for performance and do not affect the
      determinism of the end result. As after the renaming pass the uniques are all
      produced deterministically, the orderings observable by the map are also going
      to be deterministic. In the brief period before a CmmGroup has been renamed,
      a list instead of LabelMap is used to preserve the ordering.
      See Note [DCmmGroup vs CmmGroup or: Deterministic Info Tables] in GHC.Cmm.

    * In the code generation pipeline from Cmm onwards, when new uniques need to be
      created for a given pass, use @UniqDSM@ instead of the previously used @UniqSM@.
      @UniqDSM@ supplies uniques iteratively, guaranteeing uniques produced by the
      backend are deterministic accross runs.
      See Note [Deterministic Uniques in the CG] in GHC.Types.Unique.DSM.

    Also, c.f. Note [Unique Determinism]
    -}

    ---------------------------------------------------------------
    --      Top-level bindings
    ---------------------------------------------------------------

    {- 'cgTopBinding' is only used for top-level bindings, since they need
    to be allocated statically (not in the heap) and need to be labelled.
    No unboxed bindings can happen at top level.

    In the code below, the static bindings are accumulated in the
    @MkCgState@, and transferred into the ``statics'' slot by @forkStatics@.
    This is so that we can write the top level processing in a compositional
    style, with the increasing static environment being plumbed as a state
    variable. -}

    cgTopBinding :: Logger -> TmpFs -> StgToCmmConfig -> CgStgTopBinding -> FCode ()
    cgTopBinding :: Logger -> TmpFs -> StgToCmmConfig -> CgStgTopBinding -> FCode ()
    cgTopBinding Logger
    logger TmpFs
    tmpfs StgToCmmConfig
    cfg = \case
        StgTopLifted (StgNonRec BinderP 'CodeGen
    id GenStgRhs 'CodeGen
    rhs) -> do
            let (CgIdInfo
    info, FCode ()
    fcode) = StgToCmmConfig
    -> RecFlag -> Var -> GenStgRhs 'CodeGen -> (CgIdInfo, FCode ())
    cgTopRhs StgToCmmConfig
    cfg RecFlag
    NonRecursive Var
    BinderP 'CodeGen
    id GenStgRhs 'CodeGen
    rhs
            FCode ()
    fcode
            CgIdInfo -> FCode ()
    addBindC CgIdInfo
    info

        StgTopLifted (StgRec [(BinderP 'CodeGen, GenStgRhs 'CodeGen)]
    pairs) -> do
            let ([Var]
    bndrs, [GenStgRhs 'CodeGen]
    rhss) = [(Var, GenStgRhs 'CodeGen)] -> ([Var], [GenStgRhs 'CodeGen])
    forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
    unzip [(Var, GenStgRhs 'CodeGen)]
    [(BinderP 'CodeGen, GenStgRhs 'CodeGen)]
    pairs
            let pairs' :: [(Var, GenStgRhs 'CodeGen)]
    pairs' = [Var] -> [GenStgRhs 'CodeGen] -> [(Var, GenStgRhs 'CodeGen)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Var]
    bndrs [GenStgRhs 'CodeGen]
    rhss
                r :: [(CgIdInfo, FCode ())]
    r = (Var -> GenStgRhs 'CodeGen -> (CgIdInfo, FCode ()))
    -> [(Var, GenStgRhs 'CodeGen)] -> [(CgIdInfo, FCode ())]
    forall a b c. (a -> b -> c) -> [(a, b)] -> [c]
    unzipWith (StgToCmmConfig
    -> RecFlag -> Var -> GenStgRhs 'CodeGen -> (CgIdInfo, FCode ())
    cgTopRhs StgToCmmConfig
    cfg RecFlag
    Recursive) [(Var, GenStgRhs 'CodeGen)]
    pairs'
                ([CgIdInfo]
    infos, [FCode ()]
    fcodes) = [(CgIdInfo, FCode ())] -> ([CgIdInfo], [FCode ()])
    forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
    unzip [(CgIdInfo, FCode ())]
    r
            [CgIdInfo] -> FCode ()
    addBindsC [CgIdInfo]
    infos
            [FCode ()] -> FCode ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_ [FCode ()]
    fcodes

        StgTopStringLit Var
    id ByteString
    str -> do
            let label :: CLabel
    label = Name -> CLabel
    mkBytesLabel (Var -> Name
    idName Var
    id)
            -- emit either a CmmString literal or dump the string in a file and emit a
            -- CmmFileEmbed literal.  If binary blobs aren't supported,
            -- the threshold in `cfg` will be 0.
            -- See Note [Embedding large binary blobs] in GHC.CmmToAsm.Ppr
            let asString :: Bool
    asString = case StgToCmmConfig -> Maybe Word
    stgToCmmBinBlobThresh StgToCmmConfig
    cfg of
                  Just Word
    bin_blob_threshold -> WordOff -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ByteString -> WordOff
    BS.length ByteString
    str) Word -> Word -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word
    bin_blob_threshold
                  Maybe Word
    Nothing                -> Bool
    True

                (CmmLit
    lit,DCmmDecl
    decl) = if Bool
    asString
                  then CLabel -> ByteString -> (CmmLit, DCmmDecl)
    forall (raw :: Bool) info stmt.
    CLabel
    -> ByteString -> (CmmLit, GenCmmDecl (GenCmmStatics raw) info stmt)
    mkByteStringCLit CLabel
    label ByteString
    str
                  else IO (CmmLit, DCmmDecl) -> (CmmLit, DCmmDecl)
    forall a. IO a -> a
    unsafePerformIO (IO (CmmLit, DCmmDecl) -> (CmmLit, DCmmDecl))
    -> IO (CmmLit, DCmmDecl) -> (CmmLit, DCmmDecl)
    forall a b. (a -> b) -> a -> b
    $ do
                         bFile <- Logger
    -> TmpFs -> TempDir -> TempFileLifetime -> String -> IO String
    newTempName Logger
    logger TmpFs
    tmpfs (StgToCmmConfig -> TempDir
    stgToCmmTmpDir StgToCmmConfig
    cfg) TempFileLifetime
    TFL_CurrentModule String
    ".dat"
                         BS.writeFile bFile str
                         return $ mkFileEmbedLit label bFile (BS.length str)
            DCmmDecl -> FCode ()
    emitDecl DCmmDecl
    decl
            CgIdInfo -> FCode ()
    addBindC (Platform -> Var -> LambdaFormInfo -> CmmLit -> CgIdInfo
    litIdInfo (StgToCmmConfig -> Platform
    stgToCmmPlatform StgToCmmConfig
    cfg) Var
    id LambdaFormInfo
    mkLFStringLit CmmLit
    lit)

    cgTopRhs :: StgToCmmConfig -> RecFlag -> Id -> CgStgRhs -> (CgIdInfo, FCode ())
            -- The Id is passed along for setting up a binding...

    cgTopRhs :: StgToCmmConfig
    -> RecFlag -> Var -> GenStgRhs 'CodeGen -> (CgIdInfo, FCode ())
    cgTopRhs StgToCmmConfig
    cfg RecFlag
    _rec Var
    bndr (StgRhsCon CostCentreStack
    _cc DataCon
    con ConstructorNumber
    mn [StgTickish]
    _ts [StgArg]
    args Type
    _typ)
      = StgToCmmConfig
    -> Var
    -> DataCon
    -> ConstructorNumber
    -> [NonVoid StgArg]
    -> (CgIdInfo, FCode ())
    cgTopRhsCon StgToCmmConfig
    cfg Var
    bndr DataCon
    con ConstructorNumber
    mn ([StgArg] -> [NonVoid StgArg]
    assertNonVoidStgArgs [StgArg]
    args)
          -- con args are always non-void,
          -- see Note [Post-unarisation invariants] in GHC.Stg.Unarise

    cgTopRhs StgToCmmConfig
    cfg RecFlag
    rec Var
    bndr (StgRhsClosure XRhsClosure 'CodeGen
    fvs CostCentreStack
    cc UpdateFlag
    upd_flag [BinderP 'CodeGen]
    args GenStgExpr 'CodeGen
    body Type
    _typ)
      = Bool -> SDoc -> (CgIdInfo, FCode ()) -> (CgIdInfo, FCode ())
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (DIdSet -> Bool
    isEmptyDVarSet DIdSet
    XRhsClosure 'CodeGen
    fvs) (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "fvs:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> DIdSet -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DIdSet
    XRhsClosure 'CodeGen
    fvs) ((CgIdInfo, FCode ()) -> (CgIdInfo, FCode ()))
    -> (CgIdInfo, FCode ()) -> (CgIdInfo, FCode ())
    forall a b. (a -> b) -> a -> b
    $   -- There should be no free variables
        Platform
    -> RecFlag
    -> Var
    -> CostCentreStack
    -> UpdateFlag
    -> [Var]
    -> GenStgExpr 'CodeGen
    -> (CgIdInfo, FCode ())
    cgTopRhsClosure (StgToCmmConfig -> Platform
    stgToCmmPlatform StgToCmmConfig
    cfg) RecFlag
    rec Var
    bndr CostCentreStack
    cc UpdateFlag
    upd_flag [Var]
    [BinderP 'CodeGen]
    args GenStgExpr 'CodeGen
    body

    ---------------------------------------------------------------
    --      Module initialisation code
    ---------------------------------------------------------------

    mkModuleInit
            :: CollectedCCs         -- cost centre info
            -> FCode ()

    mkModuleInit :: CollectedCCs -> FCode ()
    mkModuleInit CollectedCCs
    cost_centre_info
      = do  { CollectedCCs -> FCode ()
    initCostCentres CollectedCCs
    cost_centre_info
            }

    ---------------------------------------------------------------
    --   Generating static stuff for algebraic data types, including
    --     * entry code for each data con
    --     * info table for each data con
    --     * for enumerations, a table of all the closures
    ---------------------------------------------------------------

    ---------------------------------------------------------------
    --      Data type constructors
    ---------------------------------------------------------------
    cgTyCon :: TyCon -> FCode ()
    -- Generate static data for each algebraic data type
    cgTyCon :: TyCon -> FCode ()
    cgTyCon TyCon
    tycon
      | Bool -> Bool
    not (TyCon -> Bool
    isBoxedDataTyCon TyCon
    tycon)  -- Type families, newtypes, and `type data` constructors
      = () -> FCode ()
    forall a. a -> FCode a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

      | Bool
    otherwise   -- An honest-to-goodness algebraic data type
      = do { -- Emit normal info_tables, for data constructors defined in this module.
             (DataCon -> FCode ()) -> [DataCon] -> FCode ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (ConInfoTableLocation -> DataCon -> FCode ()
    cgDataCon ConInfoTableLocation
    DefinitionSite) (TyCon -> [DataCon]
    tyConDataCons TyCon
    tycon)

           ; Bool -> FCode () -> FCode ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (TyCon -> Bool
    isEnumerationTyCon TyCon
    tycon) (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $
             TyCon -> FCode ()
    cgEnumerationTyCon TyCon
    tycon }

    cgEnumerationTyCon :: TyCon -> FCode ()
    -- Generate a table of static closures for an enumeration type.
    -- Note that the closure pointers in the table are tagged.
    cgEnumerationTyCon :: TyCon -> FCode ()
    cgEnumerationTyCon TyCon
    tycon
      = do platform <- FCode Platform
    getPlatform
           emitRODataLits (mkClosureTableLabel (tyConName tycon) NoCafRefs)
                 [ CmmLabelOff (mkClosureLabel (dataConName con) NoCafRefs)
                               (tagForCon platform con)
                 | con <- tyConDataCons tycon]

    cgDataCon :: ConInfoTableLocation -> DataCon -> FCode ()
    -- Generate the entry code, info tables, and (for niladic constructor)
    -- the static closure, for a constructor.
    cgDataCon :: ConInfoTableLocation -> DataCon -> FCode ()
    cgDataCon ConInfoTableLocation
    mn DataCon
    data_con
      = do  { Bool -> FCode ()
    forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
    massert (Bool -> Bool
    not (DataCon -> Bool
    isUnboxedTupleDataCon DataCon
    data_con Bool -> Bool -> Bool
    || DataCon -> Bool
    isUnboxedSumDataCon DataCon
    data_con))
            ; profile <- FCode Profile
    getProfile
            ; platform <- getPlatform
            ; let
                (tot_wds, --  #ptr_wds + #nonptr_wds
                 ptr_wds) --  #ptr_wds
                  = mkVirtConstrSizes profile arg_reps

                nonptr_wds   = WordOff
    tot_wds WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    - WordOff
    ptr_wds

                dyn_info_tbl =
                  Profile
    -> DataCon
    -> ConInfoTableLocation
    -> Bool
    -> WordOff
    -> WordOff
    -> CmmInfoTable
    mkDataConInfoTable Profile
    profile DataCon
    data_con ConInfoTableLocation
    mn Bool
    False WordOff
    ptr_wds WordOff
    nonptr_wds

                -- We're generating info tables, so we don't know and care about
                -- what the actual arguments are. Using () here as the place holder.
                arg_reps :: [PrimRep]
                arg_reps = [ PrimRep
    rep_ty
                           | Scaled Type
    ty <- DataCon -> [Scaled Type]
    dataConRepArgTys DataCon
    data_con
                           , PrimRep
    rep_ty <- HasDebugCallStack => Type -> [PrimRep]
    Type -> [PrimRep]
    typePrimRep (Scaled Type -> Type
    forall a. Scaled a -> a
    scaledThing Scaled Type
    ty)
                           ]

            ; emitClosureAndInfoTable platform dyn_info_tbl NativeDirectCall [] $
                -- NB: the closure pointer is assumed *untagged* on
                -- entry to a constructor.  If the pointer is tagged,
                -- then we should not be entering it.  This assumption
                -- is used in ldvEnter and when tagging the pointer to
                -- return it.
                -- NB 2: We don't set CC when entering data (WDP 94/06)
                do { tickyEnterDynCon
                   ; let node = CmmReg -> CmmExpr
    CmmReg (CmmReg -> CmmExpr) -> CmmReg -> CmmExpr
    forall a b. (a -> b) -> a -> b
    $ Platform -> CmmReg
    nodeReg Platform
    platform
                   ; ldvEnter node
                   ; tickyReturnOldCon (length arg_reps)
                   ; void $ emitReturn [cmmOffsetB platform node (tagForCon platform data_con)]
                   }
                        -- The case continuation code expects a tagged pointer
            }