    {-# LANGUAGE CPP #-}

    -----------------------------------------------------------------------------
    --
    -- Stg to C--: code generation for constructors
    --
    -- This module provides the support code for StgToCmm to deal with
    -- constructors on the RHSs of let(rec)s.
    --
    -- (c) The University of Glasgow 2004-2006
    --
    -----------------------------------------------------------------------------

    module GHC.StgToCmm.DataCon (
            cgTopRhsCon, buildDynCon, bindConArgs
        ) where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Platform
    import GHC.Platform.Profile

    import GHC.Stg.Syntax
    import GHC.Core  ( AltCon(..) )

    import GHC.StgToCmm.Monad
    import GHC.StgToCmm.Env
    import GHC.StgToCmm.Heap
    import GHC.StgToCmm.Layout
    import GHC.StgToCmm.Utils
    import GHC.StgToCmm.Closure

    import GHC.Cmm.Expr
    import GHC.Cmm.Utils
    import GHC.Cmm.CLabel
    import GHC.Cmm.Graph
    import GHC.Runtime.Heap.Layout
    import GHC.Types.CostCentre
    import GHC.Unit
    import GHC.Core.DataCon
    import GHC.Driver.Session
    import GHC.Data.FastString
    import GHC.Types.Id
    import GHC.Types.Id.Info( CafInfo( NoCafRefs ) )
    import GHC.Types.Name (isInternalName)
    import GHC.Types.RepType (countConRepArgs)
    import GHC.Types.Literal
    import GHC.Builtin.Utils
    import GHC.Utils.Panic
    import GHC.Utils.Misc
    import GHC.Utils.Monad (mapMaybeM)

    import Control.Monad
    import Data.Char

    ---------------------------------------------------------------
    --      Top-level constructors
    ---------------------------------------------------------------

    cgTopRhsCon :: DynFlags
                -> Id               -- Name of thing bound to this RHS
                -> DataCon          -- Id
                -> ConstructorNumber
                -> [NonVoid StgArg] -- Args
                -> (CgIdInfo, FCode ())
    cgTopRhsCon :: DynFlags
    -> Id
    -> DataCon
    -> ConstructorNumber
    -> [NonVoid StgArg]
    -> (CgIdInfo, FCode ())
    cgTopRhsCon DynFlags
    dflags Id
    id DataCon
    con ConstructorNumber
    mn [NonVoid StgArg]
    args
      | Just CgIdInfo
    static_info <- DynFlags -> Id -> DataCon -> [NonVoid StgArg] -> Maybe CgIdInfo
    precomputedStaticConInfo_maybe DynFlags
    dflags Id
    id DataCon
    con [NonVoid StgArg]
    args
      , let static_code :: FCode ()
    static_code | Name -> Bool
    isInternalName Name
    name = forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                        | Bool
    otherwise           = FCode ()
    gen_code
      = -- There is a pre-allocated static closure available; use it
        -- See Note [Precomputed static closures].
        -- For External bindings we must keep the binding,
        -- since importing modules will refer to it by name;
        -- but for Internal ones we can drop it altogether
        -- See Note [About the NameSorts] in "GHC.Types.Name" for Internal/External
        (CgIdInfo
    static_info, FCode ()
    static_code)

      -- Otherwise generate a closure for the constructor.
      | Bool
    otherwise
      = (CgIdInfo
    id_Info, FCode ()
    gen_code)

      where
       platform :: Platform
    platform      = DynFlags -> Platform
    targetPlatform DynFlags
    dflags
       id_Info :: CgIdInfo
    id_Info       = Platform -> Id -> LambdaFormInfo -> CmmLit -> CgIdInfo
    litIdInfo Platform
    platform Id
    id (DataCon -> LambdaFormInfo
    mkConLFInfo DataCon
    con) (CLabel -> CmmLit
    CmmLabel CLabel
    closure_label)
       name :: Name
    name          = Id -> Name
    idName Id
    id
       caffy :: CafInfo
    caffy         = Id -> CafInfo
    idCafInfo Id
    id -- any stgArgHasCafRefs args
       closure_label :: CLabel
    closure_label = Name -> CafInfo -> CLabel
    mkClosureLabel Name
    name CafInfo
    caffy

       gen_code :: FCode ()
    gen_code =
         do { Profile
    profile <- FCode Profile
    getProfile
            ; Module
    this_mod <- FCode Module
    getModuleName
            ; forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Platform -> OS
    platformOS Platform
    platform forall a. Eq a => a -> a -> Bool
    == OS
    OSMinGW32) forall a b. (a -> b) -> a -> b
    $
                  -- Windows DLLs have a problem with static cross-DLL refs.
                  MASSERT( not (isDllConApp dflags this_mod con (map fromNonVoid args)) )
            ; ASSERT( args `lengthIs` countConRepArgs con ) return ()

            -- LAY IT OUT
            ; let
                (Int
    tot_wds, --  #ptr_wds + #nonptr_wds
                 Int
    ptr_wds, --  #ptr_wds
                 [FieldOffOrPadding StgArg]
    nv_args_w_offsets) =
                     forall a.
    Profile
    -> ClosureHeader
    -> [NonVoid (PrimRep, a)]
    -> (Int, Int, [FieldOffOrPadding a])
    mkVirtHeapOffsetsWithPadding Profile
    profile ClosureHeader
    StdHeader ([NonVoid StgArg] -> [NonVoid (PrimRep, StgArg)]
    addArgReps [NonVoid StgArg]
    args)

            ; let
                -- Decompose padding into units of length 8, 4, 2, or 1 bytes to
                -- allow the implementation of mk_payload to use widthFromBytes,
                -- which only handles these cases.
                fix_padding :: [FieldOffOrPadding a] -> [FieldOffOrPadding a]
    fix_padding (x :: FieldOffOrPadding a
    x@(Padding Int
    n Int
    off) : [FieldOffOrPadding a]
    rest)
                  | Int
    n forall a. Eq a => a -> a -> Bool
    == Int
    0                 = [FieldOffOrPadding a] -> [FieldOffOrPadding a]
    fix_padding [FieldOffOrPadding a]
    rest
                  | Int
    n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Int
    1,Int
    2,Int
    4,Int
    8]     = FieldOffOrPadding a
    x forall a. a -> [a] -> [a]
    : [FieldOffOrPadding a] -> [FieldOffOrPadding a]
    fix_padding [FieldOffOrPadding a]
    rest
                  | Int
    n forall a. Ord a => a -> a -> Bool
    > Int
    8                  = Int -> [FieldOffOrPadding a]
    add_pad Int
    8
                  | Int
    n forall a. Ord a => a -> a -> Bool
    > Int
    4                  = Int -> [FieldOffOrPadding a]
    add_pad Int
    4
                  | Int
    n forall a. Ord a => a -> a -> Bool
    > Int
    2                  = Int -> [FieldOffOrPadding a]
    add_pad Int
    2
                  | Bool
    otherwise              = Int -> [FieldOffOrPadding a]
    add_pad Int
    1
                  where add_pad :: Int -> [FieldOffOrPadding a]
    add_pad Int
    m = forall a. Int -> Int -> FieldOffOrPadding a
    Padding Int
    m Int
    off forall a. a -> [a] -> [a]
    : [FieldOffOrPadding a] -> [FieldOffOrPadding a]
    fix_padding (forall a. Int -> Int -> FieldOffOrPadding a
    Padding (Int
    nforall a. Num a => a -> a -> a
    -Int
    m) (Int
    offforall a. Num a => a -> a -> a
    +Int
    m) forall a. a -> [a] -> [a]
    : [FieldOffOrPadding a]
    rest)
                fix_padding (FieldOffOrPadding a
    x : [FieldOffOrPadding a]
    rest)     = FieldOffOrPadding a
    x forall a. a -> [a] -> [a]
    : [FieldOffOrPadding a] -> [FieldOffOrPadding a]
    fix_padding [FieldOffOrPadding a]
    rest
                fix_padding []             = []

                mk_payload :: FieldOffOrPadding StgArg -> FCode CmmLit
    mk_payload (Padding Int
    len Int
    _) = forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> Width -> CmmLit
    CmmInt Integer
    0 (Int -> Width
    widthFromBytes Int
    len))
                mk_payload (FieldOff NonVoid StgArg
    arg Int
    _) = do
                    CmmExpr
    amode <- NonVoid StgArg -> FCode CmmExpr
    getArgAmode NonVoid StgArg
    arg
                    case CmmExpr
    amode of
                      CmmLit CmmLit
    lit -> forall (m :: * -> *) a. Monad m => a -> m a
    return CmmLit
    lit
                      CmmExpr
    _          -> forall a. String -> a
    panic String
    "GHC.StgToCmm.DataCon.cgTopRhsCon"

                nonptr_wds :: Int
    nonptr_wds = Int
    tot_wds forall a. Num a => a -> a -> a
    - Int
    ptr_wds

                 -- we're not really going to emit an info table, so having
                 -- to make a CmmInfoTable is a bit overkill, but mkStaticClosureFields
                 -- needs to poke around inside it.
                info_tbl :: CmmInfoTable
    info_tbl = Profile
    -> DataCon
    -> ConInfoTableLocation
    -> Bool
    -> Int
    -> Int
    -> CmmInfoTable
    mkDataConInfoTable Profile
    profile DataCon
    con (Module -> ConstructorNumber -> ConInfoTableLocation
    addModuleLoc Module
    this_mod ConstructorNumber
    mn) Bool
    True Int
    ptr_wds Int
    nonptr_wds

            ; [CmmLit]
    payload <- forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM FieldOffOrPadding StgArg -> FCode CmmLit
    mk_payload (forall {a}. [FieldOffOrPadding a] -> [FieldOffOrPadding a]
    fix_padding [FieldOffOrPadding StgArg]
    nv_args_w_offsets)
                    -- NB1: nv_args_w_offsets is sorted into ptrs then non-ptrs
                    -- NB2: all the amodes should be Lits!
                    --      TODO (osa): Why?

                    -- BUILD THE OBJECT
                    --
                -- We're generating info tables, so we don't know and care about
                -- what the actual arguments are. Using () here as the place holder.

            ; CLabel -> CmmInfoTable -> CostCentreStack -> [CmmLit] -> FCode ()
    emitDataCon CLabel
    closure_label CmmInfoTable
    info_tbl CostCentreStack
    dontCareCCS [CmmLit]
    payload }

    addModuleLoc :: Module -> ConstructorNumber -> ConInfoTableLocation
    addModuleLoc :: Module -> ConstructorNumber -> ConInfoTableLocation
    addModuleLoc Module
    this_mod ConstructorNumber
    mn = do
      case ConstructorNumber
    mn of
        ConstructorNumber
    NoNumber -> ConInfoTableLocation
    DefinitionSite
        Numbered Int
    n -> Module -> Int -> ConInfoTableLocation
    UsageSite Module
    this_mod Int
    n

    ---------------------------------------------------------------
    --      Lay out and allocate non-top-level constructors
    ---------------------------------------------------------------

    buildDynCon :: Id                 -- Name of the thing to which this constr will
                                      -- be bound
                -> ConstructorNumber
                -> Bool               -- is it genuinely bound to that name, or just
                                      -- for profiling?
                -> CostCentreStack    -- Where to grab cost centre from;
                                      -- current CCS if currentOrSubsumedCCS
                -> DataCon            -- The data constructor
                -> [NonVoid StgArg]   -- Its args
                -> FCode (CgIdInfo, FCode CmmAGraph)
                   -- Return details about how to find it and initialization code
    buildDynCon :: Id
    -> ConstructorNumber
    -> Bool
    -> CostCentreStack
    -> DataCon
    -> [NonVoid StgArg]
    -> FCode (CgIdInfo, FCode CmmAGraph)
    buildDynCon Id
    binder ConstructorNumber
    mn Bool
    actually_bound CostCentreStack
    cc DataCon
    con [NonVoid StgArg]
    args
        = do DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
             DynFlags
    -> Id
    -> ConstructorNumber
    -> Bool
    -> CostCentreStack
    -> DataCon
    -> [NonVoid StgArg]
    -> FCode (CgIdInfo, FCode CmmAGraph)
    buildDynCon' DynFlags
    dflags Id
    binder ConstructorNumber
    mn Bool
    actually_bound CostCentreStack
    cc DataCon
    con [NonVoid StgArg]
    args

    buildDynCon' :: DynFlags
                 -> Id -> ConstructorNumber
                 -> Bool
                 -> CostCentreStack
                 -> DataCon
                 -> [NonVoid StgArg]
                 -> FCode (CgIdInfo, FCode CmmAGraph)

    {- We used to pass a boolean indicating whether all the
    args were of size zero, so we could use a static
    constructor; but I concluded that it just isn't worth it.
    Now I/O uses unboxed tuples there just aren't any constructors
    with all size-zero args.

    The reason for having a separate argument, rather than looking at
    the addr modes of the args is that we may be in a "knot", and
    premature looking at the args will cause the compiler to black-hole!
    -}

    buildDynCon' :: DynFlags
    -> Id
    -> ConstructorNumber
    -> Bool
    -> CostCentreStack
    -> DataCon
    -> [NonVoid StgArg]
    -> FCode (CgIdInfo, FCode CmmAGraph)
    buildDynCon' DynFlags
    dflags Id
    binder ConstructorNumber
    _ Bool
    _ CostCentreStack
    _cc DataCon
    con [NonVoid StgArg]
    args
      | Just CgIdInfo
    cgInfo <- DynFlags -> Id -> DataCon -> [NonVoid StgArg] -> Maybe CgIdInfo
    precomputedStaticConInfo_maybe DynFlags
    dflags Id
    binder DataCon
    con [NonVoid StgArg]
    args
      -- , pprTrace "noCodeLocal:" (ppr (binder,con,args,cgInfo)) True
      = forall (m :: * -> *) a. Monad m => a -> m a
    return (CgIdInfo
    cgInfo, forall (m :: * -> *) a. Monad m => a -> m a
    return CmmAGraph
    mkNop)

    -------- buildDynCon': the general case -----------
    buildDynCon' DynFlags
    _ Id
    binder ConstructorNumber
    mn Bool
    actually_bound CostCentreStack
    ccs DataCon
    con [NonVoid StgArg]
    args
      = do  { (CgIdInfo
    id_info, LocalReg
    reg) <- Id -> LambdaFormInfo -> FCode (CgIdInfo, LocalReg)
    rhsIdInfo Id
    binder LambdaFormInfo
    lf_info
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (CgIdInfo
    id_info, LocalReg -> FCode CmmAGraph
    gen_code LocalReg
    reg)
            }
     where
      lf_info :: LambdaFormInfo
    lf_info = DataCon -> LambdaFormInfo
    mkConLFInfo DataCon
    con

      gen_code :: LocalReg -> FCode CmmAGraph
    gen_code LocalReg
    reg
        = do  { Module
    modu <- FCode Module
    getModuleName
              ; Profile
    profile <- FCode Profile
    getProfile
              ; let platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile
                    (Int
    tot_wds, Int
    ptr_wds, [(NonVoid StgArg, Int)]
    args_w_offsets)
                       = forall a.
    Profile -> [NonVoid (PrimRep, a)] -> (Int, Int, [(NonVoid a, Int)])
    mkVirtConstrOffsets Profile
    profile ([NonVoid StgArg] -> [NonVoid (PrimRep, StgArg)]
    addArgReps [NonVoid StgArg]
    args)
                    nonptr_wds :: Int
    nonptr_wds = Int
    tot_wds forall a. Num a => a -> a -> a
    - Int
    ptr_wds
                    info_tbl :: CmmInfoTable
    info_tbl = Profile
    -> DataCon
    -> ConInfoTableLocation
    -> Bool
    -> Int
    -> Int
    -> CmmInfoTable
    mkDataConInfoTable Profile
    profile DataCon
    con (Module -> ConstructorNumber -> ConInfoTableLocation
    addModuleLoc Module
    modu ConstructorNumber
    mn) Bool
    False
                                    Int
    ptr_wds Int
    nonptr_wds
              ; let ticky_name :: Maybe Id
    ticky_name | Bool
    actually_bound = forall a. a -> Maybe a
    Just Id
    binder
                               | Bool
    otherwise = forall a. Maybe a
    Nothing

              ; CmmExpr
    hp_plus_n <- Maybe Id
    -> CmmInfoTable
    -> LambdaFormInfo
    -> CmmExpr
    -> CmmExpr
    -> [(NonVoid StgArg, Int)]
    -> FCode CmmExpr
    allocDynClosure Maybe Id
    ticky_name CmmInfoTable
    info_tbl LambdaFormInfo
    lf_info
                                              CmmExpr
    use_cc CmmExpr
    blame_cc [(NonVoid StgArg, Int)]
    args_w_offsets
              ; forall (m :: * -> *) a. Monad m => a -> m a
    return (Platform -> LocalReg -> LambdaFormInfo -> CmmExpr -> CmmAGraph
    mkRhsInit Platform
    platform LocalReg
    reg LambdaFormInfo
    lf_info CmmExpr
    hp_plus_n) }
        where
          use_cc :: CmmExpr
    use_cc      -- cost-centre to stick in the object
            | CostCentreStack -> Bool
    isCurrentCCS CostCentreStack
    ccs = CmmExpr
    cccsExpr
            | Bool
    otherwise        = forall a. String -> a
    panic String
    "buildDynCon: non-current CCS not implemented"

          blame_cc :: CmmExpr
    blame_cc = CmmExpr
    use_cc -- cost-centre on which to blame the alloc (same)

    {- Note [Precomputed static closures]
       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    For Char/Int closures there are some value closures
    built into the RTS. This is the case for all values in
    the range mINT_INTLIKE .. mAX_INTLIKE (or CHARLIKE).
    See Note [CHARLIKE and INTLIKE closures.] in the RTS code.

    Similarly zero-arity constructors have a closure
    in their defining Module we can use.

    If possible we prefer to refer to those existing
    closure instead of building new ones.

    This is true at compile time where we do this replacement
    in this module.
    But also at runtime where the GC does the same (but only for
    INT/CHAR closures).

    `precomputedStaticConInfo_maybe` checks if a given constructor application
    can be replaced with a reference to a existing static closure.

    If so the code will reference the existing closure when accessing
    the binding.
    Unless the binding is visible to other modules we also generate
    no code for the binding itself. We can do this since then we can
    always reference the existing closure.

    See Note [About the NameSorts] for the definition of external names.
    For external bindings we must still generate a closure,
    but won't use it inside this module.
    This can sometimes reduce cache pressure. Since:
    * If somebody uses the exported binding:
      + This module will reference the existing closure.
      + GC will reference the existing closure.
      + The importing module will reference the built closure.
    * If nobody uses the exported binding:
      + This module will reference the RTS closures.
      + GC references the RTS closures

    In the later case we avoided loading the built closure into the cache which
    is what we optimize for here.

    Consider this example using Ints.

        module M(externalInt, foo, bar) where

        externalInt = 1 :: Int
        internalInt = 1 :: Int
        { -# NOINLINE foo #- }
        foo = Just internalInt :: Maybe Int
        bar = Just externalInt

        ==================== STG: ====================
        externalInt = I#! [1#];

        bar = Just! [externalInt];

        internalInt_rc = I#! [2#];

        foo = Just! [internalInt_rc];

    For externally visible bindings we must generate closures
    since those may be referenced by their symbol `<name>_closure`
    when imported.

    `externalInt` is visible to other modules so we generate a closure:

        [section ""data" . M.externalInt_closure" {
            M.externalInt_closure:
                const GHC.Types.I#_con_info;
                const 1;
        }]

    It will be referenced inside this module via `M.externalInt_closure+1`

    `internalInt` is however a internal name. As such we generate no code for
    it. References to it are replaced with references to the static closure as
    we can see in the closure built for `foo`:

        [section ""data" . M.foo_closure" {
            M.foo_closure:
                const GHC.Maybe.Just_con_info;
                const stg_INTLIKE_closure+289; // == I# 2
                const 3;
        }]

    This holds for both local and top level bindings.

    We don't support this optimization when compiling into Windows DLLs yet
    because they don't support cross package data references well.
    -}

    -- (precomputedStaticConInfo_maybe dflags id con args)
    --     returns (Just cg_id_info)
    -- if there is a precomputed static closure for (con args).
    -- In that case, cg_id_info addresses it.
    -- See Note [Precomputed static closures]
    precomputedStaticConInfo_maybe :: DynFlags -> Id -> DataCon -> [NonVoid StgArg] -> Maybe CgIdInfo
    precomputedStaticConInfo_maybe :: DynFlags -> Id -> DataCon -> [NonVoid StgArg] -> Maybe CgIdInfo
    precomputedStaticConInfo_maybe DynFlags
    dflags Id
    binder DataCon
    con []
    -- Nullary constructors
      | DataCon -> Bool
    isNullaryRepDataCon DataCon
    con
      = forall a. a -> Maybe a
    Just forall a b. (a -> b) -> a -> b
    $ Platform -> Id -> LambdaFormInfo -> CmmLit -> CgIdInfo
    litIdInfo (DynFlags -> Platform
    targetPlatform DynFlags
    dflags) Id
    binder (DataCon -> LambdaFormInfo
    mkConLFInfo DataCon
    con)
                    (CLabel -> CmmLit
    CmmLabel (Name -> CafInfo -> CLabel
    mkClosureLabel (DataCon -> Name
    dataConName DataCon
    con) CafInfo
    NoCafRefs))
    precomputedStaticConInfo_maybe DynFlags
    dflags Id
    binder DataCon
    con [NonVoid StgArg
    arg]
      -- Int/Char values with existing closures in the RTS
      | Bool
    intClosure Bool -> Bool -> Bool
    || Bool
    charClosure
      , Platform -> OS
    platformOS Platform
    platform forall a. Eq a => a -> a -> Bool
    /= OS
    OSMinGW32 Bool -> Bool -> Bool
    || Bool -> Bool
    not (DynFlags -> Bool
    positionIndependent DynFlags
    dflags)
      , Just Integer
    val <- NonVoid StgArg -> Maybe Integer
    getClosurePayload NonVoid StgArg
    arg
      , Integer -> Bool
    inRange Integer
    val
      = let intlike_lbl :: CLabel
    intlike_lbl   = UnitId -> FastString -> CLabel
    mkCmmClosureLabel UnitId
    rtsUnitId (String -> FastString
    fsLit String
    label)
            val_int :: Int
    val_int = forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    val :: Int
            offsetW :: Int
    offsetW = (Int
    val_int forall a. Num a => a -> a -> a
    - (forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    min_static_range)) forall a. Num a => a -> a -> a
    * (Profile -> Int
    fixedHdrSizeW Profile
    profile forall a. Num a => a -> a -> a
    + Int
    1)
                    -- INTLIKE/CHARLIKE closures consist of a header and one word payload
            static_amode :: CmmLit
    static_amode = Platform -> CLabel -> Int -> CmmLit
    cmmLabelOffW Platform
    platform CLabel
    intlike_lbl Int
    offsetW
        in forall a. a -> Maybe a
    Just forall a b. (a -> b) -> a -> b
    $ Platform -> Id -> LambdaFormInfo -> CmmLit -> CgIdInfo
    litIdInfo Platform
    platform Id
    binder (DataCon -> LambdaFormInfo
    mkConLFInfo DataCon
    con) CmmLit
    static_amode
      where
        profile :: Profile
    profile = DynFlags -> Profile
    targetProfile DynFlags
    dflags
        platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile
        intClosure :: Bool
    intClosure = DataCon -> Bool
    maybeIntLikeCon DataCon
    con
        charClosure :: Bool
    charClosure = DataCon -> Bool
    maybeCharLikeCon DataCon
    con
        getClosurePayload :: NonVoid StgArg -> Maybe Integer
    getClosurePayload (NonVoid (StgLitArg (LitNumber LitNumType
    LitNumInt Integer
    val))) = forall a. a -> Maybe a
    Just Integer
    val
        getClosurePayload (NonVoid (StgLitArg (LitChar Char
    val))) = forall a. a -> Maybe a
    Just forall a b. (a -> b) -> a -> b
    $ (forall a b. (Integral a, Num b) => a -> b
    fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Int
    ord forall a b. (a -> b) -> a -> b
    $ Char
    val)
        getClosurePayload NonVoid StgArg
    _ = forall a. Maybe a
    Nothing
        -- Avoid over/underflow by comparisons at type Integer!
        inRange :: Integer -> Bool
        inRange :: Integer -> Bool
    inRange Integer
    val
          = Integer
    val forall a. Ord a => a -> a -> Bool
    >= Integer
    min_static_range Bool -> Bool -> Bool
    && Integer
    val forall a. Ord a => a -> a -> Bool
    <= Integer
    max_static_range

        constants :: PlatformConstants
    constants = Platform -> PlatformConstants
    platformConstants Platform
    platform

        min_static_range :: Integer
        min_static_range :: Integer
    min_static_range
          | Bool
    intClosure = forall a b. (Integral a, Num b) => a -> b
    fromIntegral (PlatformConstants -> Int
    pc_MIN_INTLIKE PlatformConstants
    constants)
          | Bool
    charClosure = forall a b. (Integral a, Num b) => a -> b
    fromIntegral (PlatformConstants -> Int
    pc_MIN_CHARLIKE PlatformConstants
    constants)
          | Bool
    otherwise = forall a. String -> a
    panic String
    "precomputedStaticConInfo_maybe: Unknown closure type"
        max_static_range :: Integer
    max_static_range
          | Bool
    intClosure = forall a b. (Integral a, Num b) => a -> b
    fromIntegral (PlatformConstants -> Int
    pc_MAX_INTLIKE PlatformConstants
    constants)
          | Bool
    charClosure = forall a b. (Integral a, Num b) => a -> b
    fromIntegral (PlatformConstants -> Int
    pc_MAX_CHARLIKE PlatformConstants
    constants)
          | Bool
    otherwise = forall a. String -> a
    panic String
    "precomputedStaticConInfo_maybe: Unknown closure type"
        label :: String
    label
          | Bool
    intClosure = String
    "stg_INTLIKE"
          | Bool
    charClosure =  String
    "stg_CHARLIKE"
          | Bool
    otherwise = forall a. String -> a
    panic String
    "precomputedStaticConInfo_maybe: Unknown closure type"

    precomputedStaticConInfo_maybe DynFlags
    _ Id
    _ DataCon
    _ [NonVoid StgArg]
    _ = forall a. Maybe a
    Nothing

    ---------------------------------------------------------------
    --      Binding constructor arguments
    ---------------------------------------------------------------

    bindConArgs :: AltCon -> LocalReg -> [NonVoid Id] -> FCode [LocalReg]
    -- bindConArgs is called from cgAlt of a case
    -- (bindConArgs con args) augments the environment with bindings for the
    -- binders args, assuming that we have just returned from a 'case' which
    -- found a con
    bindConArgs :: AltCon -> LocalReg -> [NonVoid Id] -> FCode [LocalReg]
    bindConArgs (DataAlt DataCon
    con) LocalReg
    base [NonVoid Id]
    args
      = ASSERT(not (isUnboxedTupleDataCon con))
        do Profile
    profile <- FCode Profile
    getProfile
           Platform
    platform <- FCode Platform
    getPlatform
           let (Int
    _, Int
    _, [(NonVoid Id, Int)]
    args_w_offsets) = forall a.
    Profile -> [NonVoid (PrimRep, a)] -> (Int, Int, [(NonVoid a, Int)])
    mkVirtConstrOffsets Profile
    profile ([NonVoid Id] -> [NonVoid (PrimRep, Id)]
    addIdReps [NonVoid Id]
    args)
               tag :: Int
    tag = Platform -> DataCon -> Int
    tagForCon Platform
    platform DataCon
    con

               -- The binding below forces the masking out of the tag bits
               -- when accessing the constructor field.
               bind_arg :: (NonVoid Id, ByteOff) -> FCode (Maybe LocalReg)
               bind_arg :: (NonVoid Id, Int) -> FCode (Maybe LocalReg)
    bind_arg (arg :: NonVoid Id
    arg@(NonVoid Id
    b), Int
    offset)
                 | Id -> Bool
    isDeadBinder Id
    b  -- See Note [Dead-binder optimisation] in GHC.StgToCmm.Expr
                 = forall (m :: * -> *) a. Monad m => a -> m a
    return forall a. Maybe a
    Nothing
                 | Bool
    otherwise
                 = do { CmmAGraph -> FCode ()
    emit forall a b. (a -> b) -> a -> b
    $ Platform -> LocalReg -> LocalReg -> Int -> Int -> CmmAGraph
    mkTaggedObjectLoad Platform
    platform (Platform -> NonVoid Id -> LocalReg
    idToReg Platform
    platform NonVoid Id
    arg)
                                                  LocalReg
    base Int
    offset Int
    tag
                      ; forall a. a -> Maybe a
    Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NonVoid Id -> FCode LocalReg
    bindArgToReg NonVoid Id
    arg }

           forall (m :: * -> *) a b.
    Applicative m =>
    (a -> m (Maybe b)) -> [a] -> m [b]
    mapMaybeM (NonVoid Id, Int) -> FCode (Maybe LocalReg)
    bind_arg [(NonVoid Id, Int)]
    args_w_offsets

    bindConArgs AltCon
    _other_con LocalReg
    _base [NonVoid Id]
    args
      = ASSERT( null args ) return []