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

    module GHC.StgToCmm.Bind (
            cgTopRhsClosure,
            cgBind,
            emitBlackHoleCode,
            pushUpdateFrame, emitUpdateFrame
      ) where

    import GHC.Prelude hiding ((<*>))

    import GHC.Platform
    import GHC.Platform.Profile

    import GHC.StgToCmm.Expr
    import GHC.StgToCmm.Monad
    import GHC.StgToCmm.Env
    import GHC.StgToCmm.DataCon
    import GHC.StgToCmm.Heap
    import GHC.StgToCmm.Prof (ldvEnterClosure, enterCostCentreFun, enterCostCentreThunk,
                       initUpdFrameProf)
    import GHC.StgToCmm.Ticky
    import GHC.StgToCmm.Layout
    import GHC.StgToCmm.Utils
    import GHC.StgToCmm.Closure
    import GHC.StgToCmm.Foreign    (emitPrimCall)

    import GHC.Cmm.Graph
    import GHC.Core          ( AltCon(..) )
    import GHC.Cmm.BlockId
    import GHC.Runtime.Heap.Layout
    import GHC.Cmm
    import GHC.Cmm.Info
    import GHC.Cmm.Utils
    import GHC.Cmm.CLabel
    import GHC.Stg.Syntax
    import GHC.Types.CostCentre
    import GHC.Types.Id
    import GHC.Types.Id.Info
    import GHC.Types.Name
    import GHC.Unit.Module
    import GHC.Data.List.SetOps
    import GHC.Utils.Misc
    import GHC.Types.Var.Set
    import GHC.Types.Basic
    import GHC.Types.Tickish ( tickishIsCode )
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Data.FastString
    import GHC.Driver.Session
    import GHC.Driver.Ppr

    import Control.Monad

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

    -- For closures bound at top level, allocate in static space.
    -- They should have no free variables.

    cgTopRhsClosure :: Platform
                    -> RecFlag              -- member of a recursive group?
                    -> Id
                    -> CostCentreStack      -- Optional cost centre annotation
                    -> UpdateFlag
                    -> [Id]                 -- Args
                    -> CgStgExpr
                    -> (CgIdInfo, FCode ())

    cgTopRhsClosure :: Platform
    -> RecFlag
    -> Id
    -> CostCentreStack
    -> UpdateFlag
    -> [Id]
    -> CgStgExpr
    -> (CgIdInfo, FCode ())
    cgTopRhsClosure Platform
    platform RecFlag
    rec Id
    id CostCentreStack
    ccs UpdateFlag
    upd_flag [Id]
    args CgStgExpr
    body =
      let closure_label :: CLabel
    closure_label = Name -> CafInfo -> CLabel
    mkLocalClosureLabel (Id -> Name
    idName Id
    id) (Id -> CafInfo
    idCafInfo Id
    id)
          cg_id_info :: CgIdInfo
    cg_id_info    = Platform -> Id -> LambdaFormInfo -> CmmLit -> CgIdInfo
    litIdInfo Platform
    platform Id
    id LambdaFormInfo
    lf_info (CLabel -> CmmLit
    CmmLabel CLabel
    closure_label)
          lf_info :: LambdaFormInfo
    lf_info       = Platform
    -> Id
    -> TopLevelFlag
    -> [NonVoid Id]
    -> UpdateFlag
    -> [Id]
    -> LambdaFormInfo
    mkClosureLFInfo Platform
    platform Id
    id TopLevelFlag
    TopLevel [] UpdateFlag
    upd_flag [Id]
    args
      in (CgIdInfo
    cg_id_info, LambdaFormInfo -> CLabel -> FCode ()
    gen_code LambdaFormInfo
    lf_info CLabel
    closure_label)
      where
      -- special case for a indirection (f = g).  We create an IND_STATIC
      -- closure pointing directly to the indirectee.  This is exactly
      -- what the CAF will eventually evaluate to anyway, we're just
      -- shortcutting the whole process, and generating a lot less code
      -- (#7308). Eventually the IND_STATIC closure will be eliminated
      -- by assembly '.equiv' directives, where possible (#15155).
      -- See note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
      --
      -- Note: we omit the optimisation when this binding is part of a
      -- recursive group, because the optimisation would inhibit the black
      -- hole detection from working in that case.  Test
      -- concurrent/should_run/4030 fails, for instance.
      --
      gen_code :: LambdaFormInfo -> CLabel -> FCode ()
    gen_code LambdaFormInfo
    _ CLabel
    closure_label
        | StgApp Id
    f [] <- CgStgExpr
    body, [Id] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Id]
    args, RecFlag -> Bool
    isNonRec RecFlag
    rec
        = do
             CgIdInfo
    cg_info <- Id -> FCode CgIdInfo
    getCgIdInfo Id
    f
             CLabel -> CmmInfoTable -> CostCentreStack -> [CmmLit] -> FCode ()
    emitDataCon CLabel
    closure_label CmmInfoTable
    indStaticInfoTable CostCentreStack
    ccs [CmmExpr -> CmmLit
    unLit (CgIdInfo -> CmmExpr
    idInfoToAmode CgIdInfo
    cg_info)]

      gen_code LambdaFormInfo
    lf_info CLabel
    _closure_label
       = do { Profile
    profile <- FCode Profile
    getProfile
            ; DynFlags
    dflags <- FCode DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
            ; let name :: Name
    name = Id -> Name
    idName Id
    id
            ; Module
    mod_name <- FCode Module
    getModuleName
            ; let descr :: String
    descr         = DynFlags -> Module -> Name -> String
    closureDescription DynFlags
    dflags Module
    mod_name Name
    name
                  closure_info :: ClosureInfo
    closure_info  = Profile
    -> Bool
    -> Id
    -> LambdaFormInfo
    -> ByteOff
    -> ByteOff
    -> String
    -> ClosureInfo
    mkClosureInfo Profile
    profile Bool
    True Id
    id LambdaFormInfo
    lf_info ByteOff
    0 ByteOff
    0 String
    descr

            -- We don't generate the static closure here, because we might
            -- want to add references to static closures to it later.  The
            -- static closure is generated by GHC.Cmm.Info.Build.updInfoSRTs,
            -- See Note [SRTs], specifically the [FUN] optimisation.

            ; let fv_details :: [(NonVoid Id, ByteOff)]
                  header :: ClosureHeader
    header = if LambdaFormInfo -> Bool
    isLFThunk LambdaFormInfo
    lf_info then ClosureHeader
    ThunkHeader else ClosureHeader
    StdHeader
                  (ByteOff
    _, ByteOff
    _, [(NonVoid Id, ByteOff)]
    fv_details) = Profile
    -> ClosureHeader
    -> [NonVoid (PrimRep, Id)]
    -> (ByteOff, ByteOff, [(NonVoid Id, ByteOff)])
    forall a.
    Profile
    -> ClosureHeader
    -> [NonVoid (PrimRep, a)]
    -> (ByteOff, ByteOff, [(NonVoid a, ByteOff)])
    mkVirtHeapOffsets Profile
    profile ClosureHeader
    header []
            -- Don't drop the non-void args until the closure info has been made
            ; FCode () -> FCode ()
    forkClosureBody (Bool
    -> Id
    -> ClosureInfo
    -> CostCentreStack
    -> [Id]
    -> CgStgExpr
    -> [(NonVoid Id, ByteOff)]
    -> FCode ()
    closureCodeBody Bool
    True Id
    id ClosureInfo
    closure_info CostCentreStack
    ccs
                                    [Id]
    args CgStgExpr
    body [(NonVoid Id, ByteOff)]
    fv_details)

            ; () -> FCode ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return () }

      unLit :: CmmExpr -> CmmLit
    unLit (CmmLit CmmLit
    l) = CmmLit
    l
      unLit CmmExpr
    _ = String -> CmmLit
    forall a. String -> a
    panic String
    "unLit"

    ------------------------------------------------------------------------
    --              Non-top-level bindings
    ------------------------------------------------------------------------

    cgBind :: CgStgBinding -> FCode ()
    cgBind :: CgStgBinding -> FCode ()
    cgBind (StgNonRec BinderP 'CodeGen
    name GenStgRhs 'CodeGen
    rhs)
      = do  { (CgIdInfo
    info, FCode CmmAGraph
    fcode) <- Id -> GenStgRhs 'CodeGen -> FCode (CgIdInfo, FCode CmmAGraph)
    cgRhs Id
    BinderP 'CodeGen
    name GenStgRhs 'CodeGen
    rhs
            ; CgIdInfo -> FCode ()
    addBindC CgIdInfo
    info
            ; CmmAGraph
    init <- FCode CmmAGraph
    fcode
            ; CmmAGraph -> FCode ()
    emit CmmAGraph
    init }
            -- init cannot be used in body, so slightly better to sink it eagerly

    cgBind (StgRec [(BinderP 'CodeGen, GenStgRhs 'CodeGen)]
    pairs)
      = do  {  [(CgIdInfo, FCode CmmAGraph)]
    r <- [FCode (CgIdInfo, FCode CmmAGraph)]
    -> FCode [(CgIdInfo, FCode CmmAGraph)]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence ([FCode (CgIdInfo, FCode CmmAGraph)]
     -> FCode [(CgIdInfo, FCode CmmAGraph)])
    -> [FCode (CgIdInfo, FCode CmmAGraph)]
    -> FCode [(CgIdInfo, FCode CmmAGraph)]
    forall a b. (a -> b) -> a -> b
    $ (Id -> GenStgRhs 'CodeGen -> FCode (CgIdInfo, FCode CmmAGraph))
    -> [(Id, GenStgRhs 'CodeGen)]
    -> [FCode (CgIdInfo, FCode CmmAGraph)]
    forall a b c. (a -> b -> c) -> [(a, b)] -> [c]
    unzipWith Id -> GenStgRhs 'CodeGen -> FCode (CgIdInfo, FCode CmmAGraph)
    cgRhs [(Id, GenStgRhs 'CodeGen)]
    [(BinderP 'CodeGen, GenStgRhs 'CodeGen)]
    pairs
            ;  let ([CgIdInfo]
    id_infos, [FCode CmmAGraph]
    fcodes) = [(CgIdInfo, FCode CmmAGraph)] -> ([CgIdInfo], [FCode CmmAGraph])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(CgIdInfo, FCode CmmAGraph)]
    r
            ;  [CgIdInfo] -> FCode ()
    addBindsC [CgIdInfo]
    id_infos
            ;  ([CmmAGraph]
    inits, CmmAGraph
    body) <- FCode [CmmAGraph] -> FCode ([CmmAGraph], CmmAGraph)
    forall a. FCode a -> FCode (a, CmmAGraph)
    getCodeR (FCode [CmmAGraph] -> FCode ([CmmAGraph], CmmAGraph))
    -> FCode [CmmAGraph] -> FCode ([CmmAGraph], CmmAGraph)
    forall a b. (a -> b) -> a -> b
    $ [FCode CmmAGraph] -> FCode [CmmAGraph]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence [FCode CmmAGraph]
    fcodes
            ;  CmmAGraph -> FCode ()
    emit ([CmmAGraph] -> CmmAGraph
    catAGraphs [CmmAGraph]
    inits CmmAGraph -> CmmAGraph -> CmmAGraph
    <*> CmmAGraph
    body) }

    {- Note [cgBind rec]

       Recursive let-bindings are tricky.
       Consider the following pseudocode:

         let x = \_ ->  ... y ...
             y = \_ ->  ... z ...
             z = \_ ->  ... x ...
         in ...

       For each binding, we need to allocate a closure, and each closure must
       capture the address of the other closures.
       We want to generate the following C-- code:
         // Initialization Code
         x = hp - 24; // heap address of x's closure
         y = hp - 40; // heap address of x's closure
         z = hp - 64; // heap address of x's closure
         // allocate and initialize x
         m[hp-8]   = ...
         m[hp-16]  = y       // the closure for x captures y
         m[hp-24] = x_info;
         // allocate and initialize y
         m[hp-32] = z;       // the closure for y captures z
         m[hp-40] = y_info;
         // allocate and initialize z
         ...

       For each closure, we must generate not only the code to allocate and
       initialize the closure itself, but also some initialization Code that
       sets a variable holding the closure pointer.

       We could generate a pair of the (init code, body code), but since
       the bindings are recursive we also have to initialise the
       environment with the CgIdInfo for all the bindings before compiling
       anything.  So we do this in 3 stages:

         1. collect all the CgIdInfos and initialise the environment
         2. compile each binding into (init, body) code
         3. emit all the inits, and then all the bodies

       We'd rather not have separate functions to do steps 1 and 2 for
       each binding, since in practice they share a lot of code.  So we
       have just one function, cgRhs, that returns a pair of the CgIdInfo
       for step 1, and a monadic computation to generate the code in step
       2.

       The alternative to separating things in this way is to use a
       fixpoint.  That's what we used to do, but it introduces a
       maintenance nightmare because there is a subtle dependency on not
       being too strict everywhere.  Doing things this way means that the
       FCode monad can be strict, for example.
     -}

    cgRhs :: Id
          -> CgStgRhs
          -> FCode (
                     CgIdInfo         -- The info for this binding
                   , FCode CmmAGraph  -- A computation which will generate the
                                      -- code for the binding, and return an
                                      -- assignment of the form "x = Hp - n"
                                      -- (see above)
                   )

    cgRhs :: Id -> GenStgRhs 'CodeGen -> FCode (CgIdInfo, FCode CmmAGraph)
    cgRhs Id
    id (StgRhsCon CostCentreStack
    cc DataCon
    con ConstructorNumber
    mn [StgTickish]
    _ts [StgArg]
    args)
      = Name
    -> DataCon
    -> FCode (CgIdInfo, FCode CmmAGraph)
    -> FCode (CgIdInfo, FCode CmmAGraph)
    forall a. Name -> DataCon -> FCode a -> FCode a
    withNewTickyCounterCon (Id -> Name
    idName Id
    id) DataCon
    con (FCode (CgIdInfo, FCode CmmAGraph)
     -> FCode (CgIdInfo, FCode CmmAGraph))
    -> FCode (CgIdInfo, FCode CmmAGraph)
    -> FCode (CgIdInfo, FCode CmmAGraph)
    forall a b. (a -> b) -> a -> b
    $
        Id
    -> ConstructorNumber
    -> Bool
    -> CostCentreStack
    -> DataCon
    -> [NonVoid StgArg]
    -> FCode (CgIdInfo, FCode CmmAGraph)
    buildDynCon Id
    id ConstructorNumber
    mn Bool
    True CostCentreStack
    cc DataCon
    con ([StgArg] -> [NonVoid StgArg]
    assertNonVoidStgArgs [StgArg]
    args)
          -- con args are always non-void,
          -- see Note [Post-unarisation invariants] in GHC.Stg.Unarise

    {- See Note [GC recovery] in "GHC.StgToCmm.Closure" -}
    cgRhs Id
    id (StgRhsClosure XRhsClosure 'CodeGen
    fvs CostCentreStack
    cc UpdateFlag
    upd_flag [BinderP 'CodeGen]
    args CgStgExpr
    body)
      = do Profile
    profile <- FCode Profile
    getProfile
           Profile
    -> Id
    -> CostCentreStack
    -> [NonVoid Id]
    -> UpdateFlag
    -> [Id]
    -> CgStgExpr
    -> FCode (CgIdInfo, FCode CmmAGraph)
    mkRhsClosure Profile
    profile Id
    id CostCentreStack
    cc ([Id] -> [NonVoid Id]
    nonVoidIds (DVarSet -> [Id]
    dVarSetElems DVarSet
    XRhsClosure 'CodeGen
    fvs)) UpdateFlag
    upd_flag [Id]
    [BinderP 'CodeGen]
    args CgStgExpr
    body

    ------------------------------------------------------------------------
    --              Non-constructor right hand sides
    ------------------------------------------------------------------------

    mkRhsClosure :: Profile -> Id -> CostCentreStack
                 -> [NonVoid Id]                    -- Free vars
                 -> UpdateFlag
                 -> [Id]                            -- Args
                 -> CgStgExpr
                 -> FCode (CgIdInfo, FCode CmmAGraph)

    {- mkRhsClosure looks for two special forms of the right-hand side:
            a) selector thunks
            b) AP thunks

    If neither happens, it just calls mkClosureLFInfo.  You might think
    that mkClosureLFInfo should do all this, but it seems wrong for the
    latter to look at the structure of an expression

    Note [Selectors]
    ~~~~~~~~~~~~~~~~
    We look at the body of the closure to see if it's a selector---turgid,
    but nothing deep.  We are looking for a closure of {\em exactly} the
    form:

    ...  = [the_fv] \ u [] ->
             case the_fv of
               con a_1 ... a_n -> a_i

    Note [Ap thunks]
    ~~~~~~~~~~~~~~~~
    A more generic AP thunk of the form

            x = [ x_1...x_n ] \.. [] -> x_1 ... x_n

    A set of these is compiled statically into the RTS, so we just use
    those.  We could extend the idea to thunks where some of the x_i are
    global ids (and hence not free variables), but this would entail
    generating a larger thunk.  It might be an option for non-optimising
    compilation, though.

    We only generate an Ap thunk if all the free variables are pointers,
    for semi-obvious reasons.

    -}

    ---------- Note [Selectors] ------------------
    mkRhsClosure :: Profile
    -> Id
    -> CostCentreStack
    -> [NonVoid Id]
    -> UpdateFlag
    -> [Id]
    -> CgStgExpr
    -> FCode (CgIdInfo, FCode CmmAGraph)
    mkRhsClosure    Profile
    profile Id
    bndr CostCentreStack
    _cc
                    [NonVoid Id
    the_fv]                -- Just one free var
                    UpdateFlag
    upd_flag                -- Updatable thunk
                    []                      -- A thunk
                    CgStgExpr
    expr
      | let strip :: GenStgExpr p -> GenStgExpr p
    strip = (StgTickish -> Bool) -> GenStgExpr p -> GenStgExpr p
    forall (p :: StgPass).
    (StgTickish -> Bool) -> GenStgExpr p -> GenStgExpr p
    stripStgTicksTopE (Bool -> Bool
    not (Bool -> Bool) -> (StgTickish -> Bool) -> StgTickish -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StgTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishIsCode)
      , StgCase (StgApp Id
    scrutinee [{-no args-}])
             BinderP 'CodeGen
    _   -- ignore bndr
             (AlgAlt TyCon
    _)
             [(DataAlt DataCon
    _, [BinderP 'CodeGen]
    params, CgStgExpr
    sel_expr)] <- CgStgExpr -> CgStgExpr
    forall {p :: StgPass}. GenStgExpr p -> GenStgExpr p
    strip CgStgExpr
    expr
      , StgApp Id
    selectee [{-no args-}] <- CgStgExpr -> CgStgExpr
    forall {p :: StgPass}. GenStgExpr p -> GenStgExpr p
    strip CgStgExpr
    sel_expr
      , Id
    the_fv Id -> Id -> Bool
    forall a. Eq a => a -> a -> Bool
    == Id
    scrutinee                -- Scrutinee is the only free variable

      , let (ByteOff
    _, ByteOff
    _, [(NonVoid Id, ByteOff)]
    params_w_offsets) = Profile
    -> [NonVoid (PrimRep, Id)]
    -> (ByteOff, ByteOff, [(NonVoid Id, ByteOff)])
    forall a.
    Profile
    -> [NonVoid (PrimRep, a)]
    -> (ByteOff, ByteOff, [(NonVoid a, ByteOff)])
    mkVirtConstrOffsets Profile
    profile ([NonVoid Id] -> [NonVoid (PrimRep, Id)]
    addIdReps ([Id] -> [NonVoid Id]
    assertNonVoidIds [Id]
    [BinderP 'CodeGen]
    params))
                                       -- pattern binders are always non-void,
                                       -- see Note [Post-unarisation invariants] in GHC.Stg.Unarise
      , Just ByteOff
    the_offset <- [(NonVoid Id, ByteOff)] -> NonVoid Id -> Maybe ByteOff
    forall a b. Eq a => Assoc a b -> a -> Maybe b
    assocMaybe [(NonVoid Id, ByteOff)]
    params_w_offsets (Id -> NonVoid Id
    forall a. a -> NonVoid a
    NonVoid Id
    selectee)

      , let offset_into_int :: ByteOff
    offset_into_int = Platform -> ByteOff -> ByteOff
    bytesToWordsRoundUp (Profile -> Platform
    profilePlatform Profile
    profile) ByteOff
    the_offset
                              ByteOff -> ByteOff -> ByteOff
    forall a. Num a => a -> a -> a
    - Profile -> ByteOff
    fixedHdrSizeW Profile
    profile
      , ByteOff
    offset_into_int ByteOff -> ByteOff -> Bool
    forall a. Ord a => a -> a -> Bool
    <= PlatformConstants -> ByteOff
    pc_MAX_SPEC_SELECTEE_SIZE (Profile -> PlatformConstants
    profileConstants Profile
    profile) -- Offset is small enough
      = -- NOT TRUE: ASSERT(is_single_constructor)
        -- The simplifier may have statically determined that the single alternative
        -- is the only possible case and eliminated the others, even if there are
        -- other constructors in the datatype.  It's still ok to make a selector
        -- thunk in this case, because we *know* which constructor the scrutinee
        -- will evaluate to.
        --
        -- srt is discarded; it must be empty
        let lf_info :: LambdaFormInfo
    lf_info = Id -> ByteOff -> Bool -> LambdaFormInfo
    mkSelectorLFInfo Id
    bndr ByteOff
    offset_into_int (UpdateFlag -> Bool
    isUpdatable UpdateFlag
    upd_flag)
        in Id
    -> LambdaFormInfo -> [StgArg] -> FCode (CgIdInfo, FCode CmmAGraph)
    cgRhsStdThunk Id
    bndr LambdaFormInfo
    lf_info [Id -> StgArg
    StgVarArg Id
    the_fv]

    ---------- Note [Ap thunks] ------------------
    mkRhsClosure    Profile
    profile Id
    bndr CostCentreStack
    _cc
                    [NonVoid Id]
    fvs
                    UpdateFlag
    upd_flag
                    []                      -- No args; a thunk
                    (StgApp Id
    fun_id [StgArg]
    args)

      -- We are looking for an "ApThunk"; see data con ApThunk in GHC.StgToCmm.Closure
      -- of form (x1 x2 .... xn), where all the xi are locals (not top-level)
      -- So the xi will all be free variables
      | [StgArg]
    args [StgArg] -> ByteOff -> Bool
    forall a. [a] -> ByteOff -> Bool
    `lengthIs` (ByteOff
    n_fvsByteOff -> ByteOff -> ByteOff
    forall a. Num a => a -> a -> a
    -ByteOff
    1)  -- This happens only if the fun_id and
                                   -- args are all distinct local variables
                                   -- The "-1" is for fun_id
        -- Missed opportunity:   (f x x) is not detected
      , (NonVoid Id -> Bool) -> [NonVoid Id] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (PrimRep -> Bool
    isGcPtrRep (PrimRep -> Bool) -> (NonVoid Id -> PrimRep) -> NonVoid Id -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> PrimRep
    idPrimRep (Id -> PrimRep) -> (NonVoid Id -> Id) -> NonVoid Id -> PrimRep
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonVoid Id -> Id
    forall a. NonVoid a -> a
    fromNonVoid) [NonVoid Id]
    fvs
      , UpdateFlag -> Bool
    isUpdatable UpdateFlag
    upd_flag
      , ByteOff
    n_fvs ByteOff -> ByteOff -> Bool
    forall a. Ord a => a -> a -> Bool
    <= PlatformConstants -> ByteOff
    pc_MAX_SPEC_AP_SIZE (Profile -> PlatformConstants
    profileConstants Profile
    profile)
      , Bool -> Bool
    not (Profile -> Bool
    profileIsProfiling Profile
    profile)
                             -- not when profiling: we don't want to
                             -- lose information about this particular
                             -- thunk (e.g. its type) (#949)
      , Id -> ByteOff
    idArity Id
    fun_id ByteOff -> ByteOff -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteOff
    unknownArity -- don't spoil a known call

              -- Ha! an Ap thunk
      = Id
    -> LambdaFormInfo -> [StgArg] -> FCode (CgIdInfo, FCode CmmAGraph)
    cgRhsStdThunk Id
    bndr LambdaFormInfo
    lf_info [StgArg]
    payload

      where
        n_fvs :: ByteOff
    n_fvs   = [NonVoid Id] -> ByteOff
    forall (t :: * -> *) a. Foldable t => t a -> ByteOff
    length [NonVoid Id]
    fvs
        lf_info :: LambdaFormInfo
    lf_info = Id -> UpdateFlag -> ByteOff -> LambdaFormInfo
    mkApLFInfo Id
    bndr UpdateFlag
    upd_flag ByteOff
    n_fvs
        -- the payload has to be in the correct order, hence we can't
        -- just use the fvs.
        payload :: [StgArg]
    payload = Id -> StgArg
    StgVarArg Id
    fun_id StgArg -> [StgArg] -> [StgArg]
    forall a. a -> [a] -> [a]
    : [StgArg]
    args

    ---------- Default case ------------------
    mkRhsClosure Profile
    profile Id
    bndr CostCentreStack
    cc [NonVoid Id]
    fvs UpdateFlag
    upd_flag [Id]
    args CgStgExpr
    body
      = do  { let lf_info :: LambdaFormInfo
    lf_info = Platform
    -> Id
    -> TopLevelFlag
    -> [NonVoid Id]
    -> UpdateFlag
    -> [Id]
    -> LambdaFormInfo
    mkClosureLFInfo (Profile -> Platform
    profilePlatform Profile
    profile) Id
    bndr TopLevelFlag
    NotTopLevel [NonVoid Id]
    fvs UpdateFlag
    upd_flag [Id]
    args
            ; (CgIdInfo
    id_info, LocalReg
    reg) <- Id -> LambdaFormInfo -> FCode (CgIdInfo, LocalReg)
    rhsIdInfo Id
    bndr LambdaFormInfo
    lf_info
            ; (CgIdInfo, FCode CmmAGraph) -> FCode (CgIdInfo, FCode CmmAGraph)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CgIdInfo
    id_info, LambdaFormInfo -> LocalReg -> FCode CmmAGraph
    gen_code LambdaFormInfo
    lf_info LocalReg
    reg) }
     where
     gen_code :: LambdaFormInfo -> LocalReg -> FCode CmmAGraph
    gen_code LambdaFormInfo
    lf_info LocalReg
    reg
      = do  {       -- LAY OUT THE OBJECT
            -- If the binder is itself a free variable, then don't store
            -- it in the closure.  Instead, just bind it to Node on entry.
            -- NB we can be sure that Node will point to it, because we
            -- haven't told mkClosureLFInfo about this; so if the binder
            -- _was_ a free var of its RHS, mkClosureLFInfo thinks it *is*
            -- stored in the closure itself, so it will make sure that
            -- Node points to it...
            ; let   reduced_fvs :: [NonVoid Id]
    reduced_fvs = (NonVoid Id -> Bool) -> [NonVoid Id] -> [NonVoid Id]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Id -> NonVoid Id
    forall a. a -> NonVoid a
    NonVoid Id
    bndr NonVoid Id -> NonVoid Id -> Bool
    forall a. Eq a => a -> a -> Bool
    /=) [NonVoid Id]
    fvs

            ; Profile
    profile <- FCode Profile
    getProfile
            ; let platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile

            -- MAKE CLOSURE INFO FOR THIS CLOSURE
            ; Module
    mod_name <- FCode Module
    getModuleName
            ; DynFlags
    dflags <- FCode DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
            ; let   name :: Name
    name  = Id -> Name
    idName Id
    bndr
                    descr :: String
    descr = DynFlags -> Module -> Name -> String
    closureDescription DynFlags
    dflags Module
    mod_name Name
    name
                    fv_details :: [(NonVoid Id, ByteOff)]
                    header :: ClosureHeader
    header = if LambdaFormInfo -> Bool
    isLFThunk LambdaFormInfo
    lf_info then ClosureHeader
    ThunkHeader else ClosureHeader
    StdHeader
                    (ByteOff
    tot_wds, ByteOff
    ptr_wds, [(NonVoid Id, ByteOff)]
    fv_details)
                       = Profile
    -> ClosureHeader
    -> [NonVoid (PrimRep, Id)]
    -> (ByteOff, ByteOff, [(NonVoid Id, ByteOff)])
    forall a.
    Profile
    -> ClosureHeader
    -> [NonVoid (PrimRep, a)]
    -> (ByteOff, ByteOff, [(NonVoid a, ByteOff)])
    mkVirtHeapOffsets Profile
    profile ClosureHeader
    header ([NonVoid Id] -> [NonVoid (PrimRep, Id)]
    addIdReps [NonVoid Id]
    reduced_fvs)
                    closure_info :: ClosureInfo
    closure_info = Profile
    -> Bool
    -> Id
    -> LambdaFormInfo
    -> ByteOff
    -> ByteOff
    -> String
    -> ClosureInfo
    mkClosureInfo Profile
    profile Bool
    False       -- Not static
                                                 Id
    bndr LambdaFormInfo
    lf_info ByteOff
    tot_wds ByteOff
    ptr_wds
                                                 String
    descr

            -- BUILD ITS INFO TABLE AND CODE
            ; FCode () -> FCode ()
    forkClosureBody (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $
                    -- forkClosureBody: (a) ensure that bindings in here are not seen elsewhere
                    --                  (b) ignore Sequel from context; use empty Sequel
                    -- And compile the body
                    Bool
    -> Id
    -> ClosureInfo
    -> CostCentreStack
    -> [Id]
    -> CgStgExpr
    -> [(NonVoid Id, ByteOff)]
    -> FCode ()
    closureCodeBody Bool
    False Id
    bndr ClosureInfo
    closure_info CostCentreStack
    cc [Id]
    args
                                    CgStgExpr
    body [(NonVoid Id, ByteOff)]
    fv_details

            -- BUILD THE OBJECT
    --      ; (use_cc, blame_cc) <- chooseDynCostCentres cc args body
            ; let use_cc :: CmmExpr
    use_cc = CmmExpr
    cccsExpr; blame_cc :: CmmExpr
    blame_cc = CmmExpr
    cccsExpr
            ; CmmAGraph -> FCode ()
    emit (FastString -> CmmAGraph
    mkComment (FastString -> CmmAGraph) -> FastString -> CmmAGraph
    forall a b. (a -> b) -> a -> b
    $ String -> FastString
    mkFastString String
    "calling allocDynClosure")
            ; let toVarArg :: (NonVoid Id, b) -> (NonVoid StgArg, b)
    toVarArg (NonVoid Id
    a, b
    off) = (StgArg -> NonVoid StgArg
    forall a. a -> NonVoid a
    NonVoid (Id -> StgArg
    StgVarArg Id
    a), b
    off)
            ; let info_tbl :: CmmInfoTable
    info_tbl = ClosureInfo -> Id -> CostCentreStack -> CmmInfoTable
    mkCmmInfo ClosureInfo
    closure_info Id
    bndr CostCentreStack
    currentCCS
            ; CmmExpr
    hp_plus_n <- Maybe Id
    -> CmmInfoTable
    -> LambdaFormInfo
    -> CmmExpr
    -> CmmExpr
    -> [(NonVoid StgArg, ByteOff)]
    -> FCode CmmExpr
    allocDynClosure (Id -> Maybe Id
    forall a. a -> Maybe a
    Just Id
    bndr) CmmInfoTable
    info_tbl LambdaFormInfo
    lf_info CmmExpr
    use_cc CmmExpr
    blame_cc
                                             (((NonVoid Id, ByteOff) -> (NonVoid StgArg, ByteOff))
    -> [(NonVoid Id, ByteOff)] -> [(NonVoid StgArg, ByteOff)]
    forall a b. (a -> b) -> [a] -> [b]
    map (NonVoid Id, ByteOff) -> (NonVoid StgArg, ByteOff)
    forall {b}. (NonVoid Id, b) -> (NonVoid StgArg, b)
    toVarArg [(NonVoid Id, ByteOff)]
    fv_details)

            -- RETURN
            ; CmmAGraph -> FCode CmmAGraph
    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) }

    -------------------------
    cgRhsStdThunk
            :: Id
            -> LambdaFormInfo
            -> [StgArg]             -- payload
            -> FCode (CgIdInfo, FCode CmmAGraph)

    cgRhsStdThunk :: Id
    -> LambdaFormInfo -> [StgArg] -> FCode (CgIdInfo, FCode CmmAGraph)
    cgRhsStdThunk Id
    bndr LambdaFormInfo
    lf_info [StgArg]
    payload
     = do  { (CgIdInfo
    id_info, LocalReg
    reg) <- Id -> LambdaFormInfo -> FCode (CgIdInfo, LocalReg)
    rhsIdInfo Id
    bndr LambdaFormInfo
    lf_info
           ; (CgIdInfo, FCode CmmAGraph) -> FCode (CgIdInfo, FCode CmmAGraph)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CgIdInfo
    id_info, LocalReg -> FCode CmmAGraph
    gen_code LocalReg
    reg)
           }
     where
     gen_code :: LocalReg -> FCode CmmAGraph
    gen_code LocalReg
    reg  -- AHA!  A STANDARD-FORM THUNK
      = Bool -> Name -> FCode CmmAGraph -> FCode CmmAGraph
    forall a. Bool -> Name -> FCode a -> FCode a
    withNewTickyCounterStdThunk (LambdaFormInfo -> Bool
    lfUpdatable LambdaFormInfo
    lf_info) (Id -> Name
    idName Id
    bndr) (FCode CmmAGraph -> FCode CmmAGraph)
    -> FCode CmmAGraph -> FCode CmmAGraph
    forall a b. (a -> b) -> a -> b
    $
        do
      {     -- LAY OUT THE OBJECT
        Module
    mod_name <- FCode Module
    getModuleName
      ; DynFlags
    dflags <- FCode DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      ; Profile
    profile <- FCode Profile
    getProfile
      ; let platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile
            header :: ClosureHeader
    header = if LambdaFormInfo -> Bool
    isLFThunk LambdaFormInfo
    lf_info then ClosureHeader
    ThunkHeader else ClosureHeader
    StdHeader
            (ByteOff
    tot_wds, ByteOff
    ptr_wds, [(NonVoid StgArg, ByteOff)]
    payload_w_offsets)
                = Profile
    -> ClosureHeader
    -> [NonVoid (PrimRep, StgArg)]
    -> (ByteOff, ByteOff, [(NonVoid StgArg, ByteOff)])
    forall a.
    Profile
    -> ClosureHeader
    -> [NonVoid (PrimRep, a)]
    -> (ByteOff, ByteOff, [(NonVoid a, ByteOff)])
    mkVirtHeapOffsets Profile
    profile ClosureHeader
    header
                    ([NonVoid StgArg] -> [NonVoid (PrimRep, StgArg)]
    addArgReps ([StgArg] -> [NonVoid StgArg]
    nonVoidStgArgs [StgArg]
    payload))

            descr :: String
    descr = DynFlags -> Module -> Name -> String
    closureDescription DynFlags
    dflags Module
    mod_name (Id -> Name
    idName Id
    bndr)
            closure_info :: ClosureInfo
    closure_info = Profile
    -> Bool
    -> Id
    -> LambdaFormInfo
    -> ByteOff
    -> ByteOff
    -> String
    -> ClosureInfo
    mkClosureInfo Profile
    profile Bool
    False       -- Not static
                                         Id
    bndr LambdaFormInfo
    lf_info ByteOff
    tot_wds ByteOff
    ptr_wds
                                         String
    descr

    --  ; (use_cc, blame_cc) <- chooseDynCostCentres cc [{- no args-}] body
      ; let use_cc :: CmmExpr
    use_cc = CmmExpr
    cccsExpr; blame_cc :: CmmExpr
    blame_cc = CmmExpr
    cccsExpr

            -- BUILD THE OBJECT
      ; let info_tbl :: CmmInfoTable
    info_tbl = ClosureInfo -> Id -> CostCentreStack -> CmmInfoTable
    mkCmmInfo ClosureInfo
    closure_info Id
    bndr CostCentreStack
    currentCCS
      ; CmmExpr
    hp_plus_n <- Maybe Id
    -> CmmInfoTable
    -> LambdaFormInfo
    -> CmmExpr
    -> CmmExpr
    -> [(NonVoid StgArg, ByteOff)]
    -> FCode CmmExpr
    allocDynClosure (Id -> Maybe Id
    forall a. a -> Maybe a
    Just Id
    bndr) CmmInfoTable
    info_tbl LambdaFormInfo
    lf_info
                                       CmmExpr
    use_cc CmmExpr
    blame_cc [(NonVoid StgArg, ByteOff)]
    payload_w_offsets

            -- RETURN
      ; CmmAGraph -> FCode CmmAGraph
    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) }

    mkClosureLFInfo :: Platform
                    -> Id           -- The binder
                    -> TopLevelFlag -- True of top level
                    -> [NonVoid Id] -- Free vars
                    -> UpdateFlag   -- Update flag
                    -> [Id]         -- Args
                    -> LambdaFormInfo
    mkClosureLFInfo :: Platform
    -> Id
    -> TopLevelFlag
    -> [NonVoid Id]
    -> UpdateFlag
    -> [Id]
    -> LambdaFormInfo
    mkClosureLFInfo Platform
    platform Id
    bndr TopLevelFlag
    top [NonVoid Id]
    fvs UpdateFlag
    upd_flag [Id]
    args
      | [Id] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Id]
    args =
            Type -> TopLevelFlag -> [Id] -> UpdateFlag -> LambdaFormInfo
    mkLFThunk (Id -> Type
    idType Id
    bndr) TopLevelFlag
    top ((NonVoid Id -> Id) -> [NonVoid Id] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map NonVoid Id -> Id
    forall a. NonVoid a -> a
    fromNonVoid [NonVoid Id]
    fvs) UpdateFlag
    upd_flag
      | Bool
    otherwise =
            TopLevelFlag -> [Id] -> [Id] -> ArgDescr -> LambdaFormInfo
    mkLFReEntrant TopLevelFlag
    top ((NonVoid Id -> Id) -> [NonVoid Id] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map NonVoid Id -> Id
    forall a. NonVoid a -> a
    fromNonVoid [NonVoid Id]
    fvs) [Id]
    args (Platform -> [Id] -> ArgDescr
    mkArgDescr Platform
    platform [Id]
    args)

    ------------------------------------------------------------------------
    --              The code for closures
    ------------------------------------------------------------------------

    closureCodeBody :: Bool            -- whether this is a top-level binding
                    -> Id              -- the closure's name
                    -> ClosureInfo     -- Lots of information about this closure
                    -> CostCentreStack -- Optional cost centre attached to closure
                    -> [Id]            -- incoming args to the closure
                    -> CgStgExpr
                    -> [(NonVoid Id, ByteOff)] -- the closure's free vars
                    -> FCode ()

    {- There are two main cases for the code for closures.

    * If there are *no arguments*, then the closure is a thunk, and not in
      normal form. So it should set up an update frame (if it is
      shared). NB: Thunks cannot have a primitive type!

    * If there is *at least one* argument, then this closure is in
      normal form, so there is no need to set up an update frame.
    -}

    -- No args i.e. thunk
    closureCodeBody :: Bool
    -> Id
    -> ClosureInfo
    -> CostCentreStack
    -> [Id]
    -> CgStgExpr
    -> [(NonVoid Id, ByteOff)]
    -> FCode ()
    closureCodeBody Bool
    top_lvl Id
    bndr ClosureInfo
    cl_info CostCentreStack
    cc [] CgStgExpr
    body [(NonVoid Id, ByteOff)]
    fv_details
      = Bool -> Bool -> Name -> FCode () -> FCode ()
    forall a. Bool -> Bool -> Name -> FCode a -> FCode a
    withNewTickyCounterThunk
            (ClosureInfo -> Bool
    isStaticClosure ClosureInfo
    cl_info)
            (ClosureInfo -> Bool
    closureUpdReqd ClosureInfo
    cl_info)
            (ClosureInfo -> Name
    closureName ClosureInfo
    cl_info) (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $
        Bool
    -> Id
    -> LambdaFormInfo
    -> CmmInfoTable
    -> [NonVoid Id]
    -> ((ByteOff, LocalReg, [LocalReg]) -> FCode ())
    -> FCode ()
    emitClosureProcAndInfoTable Bool
    top_lvl Id
    bndr LambdaFormInfo
    lf_info CmmInfoTable
    info_tbl [] (((ByteOff, LocalReg, [LocalReg]) -> FCode ()) -> FCode ())
    -> ((ByteOff, LocalReg, [LocalReg]) -> FCode ()) -> FCode ()
    forall a b. (a -> b) -> a -> b
    $
          \(ByteOff
    _, LocalReg
    node, [LocalReg]
    _) -> ClosureInfo
    -> [(NonVoid Id, ByteOff)]
    -> CostCentreStack
    -> LocalReg
    -> CgStgExpr
    -> FCode ()
    thunkCode ClosureInfo
    cl_info [(NonVoid Id, ByteOff)]
    fv_details CostCentreStack
    cc LocalReg
    node CgStgExpr
    body
       where
         lf_info :: LambdaFormInfo
    lf_info  = ClosureInfo -> LambdaFormInfo
    closureLFInfo ClosureInfo
    cl_info
         info_tbl :: CmmInfoTable
    info_tbl = ClosureInfo -> Id -> CostCentreStack -> CmmInfoTable
    mkCmmInfo ClosureInfo
    cl_info Id
    bndr CostCentreStack
    cc

    closureCodeBody Bool
    top_lvl Id
    bndr ClosureInfo
    cl_info CostCentreStack
    cc args :: [Id]
    args@(Id
    arg0:[Id]
    _) CgStgExpr
    body [(NonVoid Id, ByteOff)]
    fv_details
      = let nv_args :: [NonVoid Id]
    nv_args = [Id] -> [NonVoid Id]
    nonVoidIds [Id]
    args
            arity :: ByteOff
    arity = [Id] -> ByteOff
    forall (t :: * -> *) a. Foldable t => t a -> ByteOff
    length [Id]
    args
        in
        -- See Note [OneShotInfo overview] in GHC.Types.Basic.
        Bool -> Name -> [NonVoid Id] -> FCode () -> FCode ()
    forall a. Bool -> Name -> [NonVoid Id] -> FCode a -> FCode a
    withNewTickyCounterFun (Id -> Bool
    isOneShotBndr Id
    arg0) (ClosureInfo -> Name
    closureName ClosureInfo
    cl_info)
            [NonVoid Id]
    nv_args (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do {

            ; let
                 lf_info :: LambdaFormInfo
    lf_info  = ClosureInfo -> LambdaFormInfo
    closureLFInfo ClosureInfo
    cl_info
                 info_tbl :: CmmInfoTable
    info_tbl = ClosureInfo -> Id -> CostCentreStack -> CmmInfoTable
    mkCmmInfo ClosureInfo
    cl_info Id
    bndr CostCentreStack
    cc

            -- Emit the main entry code
            ; Bool
    -> Id
    -> LambdaFormInfo
    -> CmmInfoTable
    -> [NonVoid Id]
    -> ((ByteOff, LocalReg, [LocalReg]) -> FCode ())
    -> FCode ()
    emitClosureProcAndInfoTable Bool
    top_lvl Id
    bndr LambdaFormInfo
    lf_info CmmInfoTable
    info_tbl [NonVoid Id]
    nv_args (((ByteOff, LocalReg, [LocalReg]) -> FCode ()) -> FCode ())
    -> ((ByteOff, LocalReg, [LocalReg]) -> FCode ()) -> FCode ()
    forall a b. (a -> b) -> a -> b
    $
                \(ByteOff
    _offset, LocalReg
    node, [LocalReg]
    arg_regs) -> do
                    -- Emit slow-entry code (for entering a closure through a PAP)
                    { Id -> ClosureInfo -> [LocalReg] -> FCode ()
    mkSlowEntryCode Id
    bndr ClosureInfo
    cl_info [LocalReg]
    arg_regs
                    ; Profile
    profile <- FCode Profile
    getProfile
                    ; Platform
    platform <- FCode Platform
    getPlatform
                    ; let node_points :: Bool
    node_points = Profile -> LambdaFormInfo -> Bool
    nodeMustPointToIt Profile
    profile LambdaFormInfo
    lf_info
                          node' :: Maybe LocalReg
    node' = if Bool
    node_points then LocalReg -> Maybe LocalReg
    forall a. a -> Maybe a
    Just LocalReg
    node else Maybe LocalReg
    forall a. Maybe a
    Nothing
                    ; BlockId
    loop_header_id <- FCode BlockId
    forall (m :: * -> *). MonadUnique m => m BlockId
    newBlockId
                    -- Extend reader monad with information that
                    -- self-recursive tail calls can be optimized into local
                    -- jumps. See Note [Self-recursive tail calls] in GHC.StgToCmm.Expr.
                    ; SelfLoopInfo -> FCode () -> FCode ()
    forall a. SelfLoopInfo -> FCode a -> FCode a
    withSelfLoop (Id
    bndr, BlockId
    loop_header_id, [LocalReg]
    arg_regs) (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do
                    {
                    -- Main payload
                    ; ClosureInfo
    -> Maybe LocalReg -> ByteOff -> [LocalReg] -> FCode () -> FCode ()
    entryHeapCheck ClosureInfo
    cl_info Maybe LocalReg
    node' ByteOff
    arity [LocalReg]
    arg_regs (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do
                    { -- emit LDV code when profiling
                      Bool -> FCode () -> FCode ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    node_points (ClosureInfo -> CmmReg -> FCode ()
    ldvEnterClosure ClosureInfo
    cl_info (LocalReg -> CmmReg
    CmmLocal LocalReg
    node))
                    -- ticky after heap check to avoid double counting
                    ; ClosureInfo -> FCode ()
    tickyEnterFun ClosureInfo
    cl_info
                    ; CostCentreStack -> CmmExpr -> FCode ()
    enterCostCentreFun CostCentreStack
    cc
                        (MachOp -> [CmmExpr] -> CmmExpr
    CmmMachOp (Platform -> MachOp
    mo_wordSub Platform
    platform)
                             [ CmmReg -> CmmExpr
    CmmReg (LocalReg -> CmmReg
    CmmLocal LocalReg
    node) -- See [NodeReg clobbered with loopification]
                             , Platform -> ByteOff -> CmmExpr
    mkIntExpr Platform
    platform (Platform -> ClosureInfo -> ByteOff
    funTag Platform
    platform ClosureInfo
    cl_info) ])
                    ; [(LocalReg, ByteOff)]
    fv_bindings <- ((NonVoid Id, ByteOff) -> FCode (LocalReg, ByteOff))
    -> [(NonVoid Id, ByteOff)] -> FCode [(LocalReg, ByteOff)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (NonVoid Id, ByteOff) -> FCode (LocalReg, ByteOff)
    bind_fv [(NonVoid Id, ByteOff)]
    fv_details
                    -- Load free vars out of closure *after*
                    -- heap check, to reduce live vars over check
                    ; Bool -> FCode () -> FCode ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    node_points (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ LocalReg -> LambdaFormInfo -> [(LocalReg, ByteOff)] -> FCode ()
    load_fvs LocalReg
    node LambdaFormInfo
    lf_info [(LocalReg, ByteOff)]
    fv_bindings
                    ; FCode ReturnKind -> FCode ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (FCode ReturnKind -> FCode ()) -> FCode ReturnKind -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ CgStgExpr -> FCode ReturnKind
    cgExpr CgStgExpr
    body
                    }}}

      }

    -- Note [NodeReg clobbered with loopification]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    --
    -- Previously we used to pass nodeReg (aka R1) here. With profiling, upon
    -- entering a closure, enterFunCCS was called with R1 passed to it. But since R1
    -- may get clobbered inside the body of a closure, and since a self-recursive
    -- tail call does not restore R1, a subsequent call to enterFunCCS received a
    -- possibly bogus value from R1. The solution is to not pass nodeReg (aka R1) to
    -- enterFunCCS. Instead, we pass node, the callee-saved temporary that stores
    -- the original value of R1. This way R1 may get modified but loopification will
    -- not care.

    -- A function closure pointer may be tagged, so we
    -- must take it into account when accessing the free variables.
    bind_fv :: (NonVoid Id, ByteOff) -> FCode (LocalReg, ByteOff)
    bind_fv :: (NonVoid Id, ByteOff) -> FCode (LocalReg, ByteOff)
    bind_fv (NonVoid Id
    id, ByteOff
    off) = do { LocalReg
    reg <- NonVoid Id -> FCode LocalReg
    rebindToReg NonVoid Id
    id; (LocalReg, ByteOff) -> FCode (LocalReg, ByteOff)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LocalReg
    reg, ByteOff
    off) }

    load_fvs :: LocalReg -> LambdaFormInfo -> [(LocalReg, ByteOff)] -> FCode ()
    load_fvs :: LocalReg -> LambdaFormInfo -> [(LocalReg, ByteOff)] -> FCode ()
    load_fvs LocalReg
    node LambdaFormInfo
    lf_info = ((LocalReg, ByteOff) -> FCode ())
    -> [(LocalReg, ByteOff)] -> FCode ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (\ (LocalReg
    reg, ByteOff
    off) ->
       do Platform
    platform <- FCode Platform
    getPlatform
          let tag :: ByteOff
    tag = Platform -> LambdaFormInfo -> ByteOff
    lfDynTag Platform
    platform LambdaFormInfo
    lf_info
          CmmAGraph -> FCode ()
    emit (CmmAGraph -> FCode ()) -> CmmAGraph -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ Platform -> LocalReg -> LocalReg -> ByteOff -> ByteOff -> CmmAGraph
    mkTaggedObjectLoad Platform
    platform LocalReg
    reg LocalReg
    node ByteOff
    off ByteOff
    tag)

    -----------------------------------------
    -- The "slow entry" code for a function.  This entry point takes its
    -- arguments on the stack.  It loads the arguments into registers
    -- according to the calling convention, and jumps to the function's
    -- normal entry point.  The function's closure is assumed to be in
    -- R1/node.
    --
    -- The slow entry point is used for unknown calls: eg. stg_PAP_entry

    mkSlowEntryCode :: Id -> ClosureInfo -> [LocalReg] -> FCode ()
    -- If this function doesn't have a specialised ArgDescr, we need
    -- to generate the function's arg bitmap and slow-entry code.
    -- Here, we emit the slow-entry code.
    mkSlowEntryCode :: Id -> ClosureInfo -> [LocalReg] -> FCode ()
    mkSlowEntryCode Id
    bndr ClosureInfo
    cl_info [LocalReg]
    arg_regs -- function closure is already in `Node'
      | Just (ByteOff
    _, ArgGen Liveness
    _) <- ClosureInfo -> Maybe (ByteOff, ArgDescr)
    closureFunInfo ClosureInfo
    cl_info
      = do Profile
    profile <- FCode Profile
    getProfile
           Platform
    platform <- FCode Platform
    getPlatform
           let node :: LocalReg
    node = Platform -> NonVoid Id -> LocalReg
    idToReg Platform
    platform (Id -> NonVoid Id
    forall a. a -> NonVoid a
    NonVoid Id
    bndr)
               slow_lbl :: CLabel
    slow_lbl = Platform -> ClosureInfo -> CLabel
    closureSlowEntryLabel  Platform
    platform ClosureInfo
    cl_info
               fast_lbl :: CLabel
    fast_lbl = Platform -> ClosureInfo -> CLabel
    closureLocalEntryLabel Platform
    platform ClosureInfo
    cl_info
               -- mkDirectJump does not clobber `Node' containing function closure
               jump :: CmmAGraph
    jump = Profile
    -> Convention -> CmmExpr -> [CmmExpr] -> ByteOff -> CmmAGraph
    mkJump Profile
    profile Convention
    NativeNodeCall
                                    (CLabel -> CmmExpr
    mkLblExpr CLabel
    fast_lbl)
                                    ((LocalReg -> CmmExpr) -> [LocalReg] -> [CmmExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map (CmmReg -> CmmExpr
    CmmReg (CmmReg -> CmmExpr) -> (LocalReg -> CmmReg) -> LocalReg -> CmmExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LocalReg -> CmmReg
    CmmLocal) (LocalReg
    node LocalReg -> [LocalReg] -> [LocalReg]
    forall a. a -> [a] -> [a]
    : [LocalReg]
    arg_regs))
                                    (Platform -> ByteOff
    initUpdFrameOff Platform
    platform)
           CmmTickScope
    tscope <- FCode CmmTickScope
    getTickScope
           Convention
    -> Maybe CmmInfoTable
    -> CLabel
    -> [LocalReg]
    -> CmmAGraphScoped
    -> FCode ()
    emitProcWithConvention Convention
    Slow Maybe CmmInfoTable
    forall a. Maybe a
    Nothing CLabel
    slow_lbl
             (LocalReg
    node LocalReg -> [LocalReg] -> [LocalReg]
    forall a. a -> [a] -> [a]
    : [LocalReg]
    arg_regs) (CmmAGraph
    jump, CmmTickScope
    tscope)
      | Bool
    otherwise = () -> FCode ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -----------------------------------------
    thunkCode :: ClosureInfo -> [(NonVoid Id, ByteOff)] -> CostCentreStack
              -> LocalReg -> CgStgExpr -> FCode ()
    thunkCode :: ClosureInfo
    -> [(NonVoid Id, ByteOff)]
    -> CostCentreStack
    -> LocalReg
    -> CgStgExpr
    -> FCode ()
    thunkCode ClosureInfo
    cl_info [(NonVoid Id, ByteOff)]
    fv_details CostCentreStack
    _cc LocalReg
    node CgStgExpr
    body
      = do { Profile
    profile <- FCode Profile
    getProfile
           ; let node_points :: Bool
    node_points = Profile -> LambdaFormInfo -> Bool
    nodeMustPointToIt Profile
    profile (ClosureInfo -> LambdaFormInfo
    closureLFInfo ClosureInfo
    cl_info)
                 node' :: Maybe LocalReg
    node'       = if Bool
    node_points then LocalReg -> Maybe LocalReg
    forall a. a -> Maybe a
    Just LocalReg
    node else Maybe LocalReg
    forall a. Maybe a
    Nothing
            ; ClosureInfo -> CmmReg -> FCode ()
    ldvEnterClosure ClosureInfo
    cl_info (LocalReg -> CmmReg
    CmmLocal LocalReg
    node) -- NB: Node always points when profiling

            -- Heap overflow check
            ; ClosureInfo
    -> Maybe LocalReg -> ByteOff -> [LocalReg] -> FCode () -> FCode ()
    entryHeapCheck ClosureInfo
    cl_info Maybe LocalReg
    node' ByteOff
    0 [] (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do
            { -- Overwrite with black hole if necessary
              -- but *after* the heap-overflow check
            ; ClosureInfo -> FCode ()
    tickyEnterThunk ClosureInfo
    cl_info
            ; Bool -> FCode () -> FCode ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ClosureInfo -> Bool
    blackHoleOnEntry ClosureInfo
    cl_info Bool -> Bool -> Bool
    && Bool
    node_points)
                    (LocalReg -> FCode ()
    blackHoleIt LocalReg
    node)

              -- Push update frame
            ; ClosureInfo -> LocalReg -> FCode () -> FCode ()
    setupUpdate ClosureInfo
    cl_info LocalReg
    node (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $
                -- We only enter cc after setting up update so
                -- that cc of enclosing scope will be recorded
                -- in update frame CAF/DICT functions will be
                -- subsumed by this enclosing cc
                do { CmmExpr -> FCode ()
    enterCostCentreThunk (CmmReg -> CmmExpr
    CmmReg CmmReg
    nodeReg)
                   ; let lf_info :: LambdaFormInfo
    lf_info = ClosureInfo -> LambdaFormInfo
    closureLFInfo ClosureInfo
    cl_info
                   ; [(LocalReg, ByteOff)]
    fv_bindings <- ((NonVoid Id, ByteOff) -> FCode (LocalReg, ByteOff))
    -> [(NonVoid Id, ByteOff)] -> FCode [(LocalReg, ByteOff)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (NonVoid Id, ByteOff) -> FCode (LocalReg, ByteOff)
    bind_fv [(NonVoid Id, ByteOff)]
    fv_details
                   ; LocalReg -> LambdaFormInfo -> [(LocalReg, ByteOff)] -> FCode ()
    load_fvs LocalReg
    node LambdaFormInfo
    lf_info [(LocalReg, ByteOff)]
    fv_bindings
                   ; FCode ReturnKind -> FCode ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (FCode ReturnKind -> FCode ()) -> FCode ReturnKind -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ CgStgExpr -> FCode ReturnKind
    cgExpr CgStgExpr
    body }}}

    ------------------------------------------------------------------------
    --              Update and black-hole wrappers
    ------------------------------------------------------------------------

    blackHoleIt :: LocalReg -> FCode ()
    -- Only called for closures with no args
    -- Node points to the closure
    blackHoleIt :: LocalReg -> FCode ()
    blackHoleIt LocalReg
    node_reg
      = CmmExpr -> FCode ()
    emitBlackHoleCode (CmmReg -> CmmExpr
    CmmReg (LocalReg -> CmmReg
    CmmLocal LocalReg
    node_reg))

    emitBlackHoleCode :: CmmExpr -> FCode ()
    emitBlackHoleCode :: CmmExpr -> FCode ()
    emitBlackHoleCode CmmExpr
    node = do
      DynFlags
    dflags <- FCode DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      Profile
    profile <- FCode Profile
    getProfile
      let platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile

      -- Eager blackholing is normally disabled, but can be turned on with
      -- -feager-blackholing.  When it is on, we replace the info pointer
      -- of the thunk with stg_EAGER_BLACKHOLE_info on entry.

      -- If we wanted to do eager blackholing with slop filling, we'd need
      -- to do it at the *end* of a basic block, otherwise we overwrite
      -- the free variables in the thunk that we still need.  We have a
      -- patch for this from Andy Cheadle, but not incorporated yet. --SDM
      -- [6/2004]
      --
      -- Previously, eager blackholing was enabled when ticky-ticky was
      -- on. But it didn't work, and it wasn't strictly necessary to bring
      -- back minimal ticky-ticky, so now EAGER_BLACKHOLING is
      -- unconditionally disabled. -- krc 1/2007

      -- Note the eager-blackholing check is here rather than in blackHoleOnEntry,
      -- because emitBlackHoleCode is called from GHC.Cmm.Parser.

      let  eager_blackholing :: Bool
    eager_blackholing =  Bool -> Bool
    not (Profile -> Bool
    profileIsProfiling Profile
    profile)
                             Bool -> Bool -> Bool
    && GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_EagerBlackHoling DynFlags
    dflags
                 -- Profiling needs slop filling (to support LDV
                 -- profiling), so currently eager blackholing doesn't
                 -- work with profiling.

      Bool -> FCode () -> FCode ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    eager_blackholing (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ do
        FCode () -> FCode ()
    forall a. FCode a -> FCode ()
    whenUpdRemSetEnabled (FCode () -> FCode ()) -> FCode () -> FCode ()
    forall a b. (a -> b) -> a -> b
    $ CmmExpr -> FCode ()
    emitUpdRemSetPushThunk CmmExpr
    node
        CmmExpr -> CmmExpr -> FCode ()
    emitStore (Platform -> CmmExpr -> ByteOff -> CmmExpr
    cmmOffsetW Platform
    platform CmmExpr
    node (Profile -> ByteOff
    fixedHdrSizeW Profile
    profile)) CmmExpr
    currentTSOExpr
        -- See Note [Heap memory barriers] in SMP.h.
        [LocalReg] -> CallishMachOp -> [CmmExpr] -> FCode ()
    emitPrimCall [] CallishMachOp
    MO_WriteBarrier []
        CmmExpr -> CmmExpr -> FCode ()
    emitStore CmmExpr
    node (CmmReg -> CmmExpr
    CmmReg (GlobalReg -> CmmReg
    CmmGlobal GlobalReg
    EagerBlackholeInfo))

    setupUpdate :: ClosureInfo -> LocalReg -> FCode () -> FCode ()
            -- Nota Bene: this function does not change Node (even if it's a CAF),
            -- so that the cost centre in the original closure can still be
            -- extracted by a subsequent enterCostCentre
    setupUpdate :: ClosureInfo -> LocalReg -> FCode () -> FCode ()
    setupUpdate ClosureInfo
    closure_info LocalReg
    node FCode ()
    body
      | Bool -> Bool
    not (LambdaFormInfo -> Bool
    lfUpdatable (ClosureInfo -> LambdaFormInfo
    closureLFInfo ClosureInfo
    closure_info))
      = FCode ()
    body

      | Bool -> Bool
    not (ClosureInfo -> Bool
    isStaticClosure ClosureInfo
    closure_info)
      = if Bool -> Bool
    not (ClosureInfo -> Bool
    closureUpdReqd ClosureInfo
    closure_info)
          then do FCode ()
    tickyUpdateFrameOmitted; FCode ()
    body
          else do
              FCode ()
    tickyPushUpdateFrame
              DynFlags
    dflags <- FCode DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
              let
                  bh :: Bool
    bh = ClosureInfo -> Bool
    blackHoleOnEntry ClosureInfo
    closure_info Bool -> Bool -> Bool
    &&
                       Bool -> Bool
    not (DynFlags -> Bool
    sccProfilingEnabled DynFlags
    dflags) Bool -> Bool -> Bool
    &&
                       GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_EagerBlackHoling DynFlags
    dflags

                  lbl :: CLabel
    lbl | Bool
    bh        = CLabel
    mkBHUpdInfoLabel
                      | Bool
    otherwise = CLabel
    mkUpdInfoLabel

              CLabel -> CmmExpr -> FCode () -> FCode ()
    pushUpdateFrame CLabel
    lbl (CmmReg -> CmmExpr
    CmmReg (LocalReg -> CmmReg
    CmmLocal LocalReg
    node)) FCode ()
    body

      | Bool
    otherwise   -- A static closure
      = do  { ClosureInfo -> FCode ()
    tickyUpdateBhCaf ClosureInfo
    closure_info

            ; if ClosureInfo -> Bool
    closureUpdReqd ClosureInfo
    closure_info
              then do       -- Blackhole the (updatable) CAF:
                    { CmmExpr
    upd_closure <- LocalReg -> FCode CmmExpr
    link_caf LocalReg
    node
                    ; CLabel -> CmmExpr -> FCode () -> FCode ()
    pushUpdateFrame CLabel
    mkBHUpdInfoLabel CmmExpr
    upd_closure FCode ()
    body }
              else do {FCode ()
    tickyUpdateFrameOmitted; FCode ()
    body}
        }

    -----------------------------------------------------------------------------
    -- Setting up update frames

    -- Push the update frame on the stack in the Entry area,
    -- leaving room for the return address that is already
    -- at the old end of the area.
    --
    pushUpdateFrame :: CLabel -> CmmExpr -> FCode () -> FCode ()
    pushUpdateFrame :: CLabel -> CmmExpr -> FCode () -> FCode ()
    pushUpdateFrame CLabel
    lbl CmmExpr
    updatee FCode ()
    body
      = do
           ByteOff
    updfr  <- FCode ByteOff
    getUpdFrameOff
           Profile
    profile <- FCode Profile
    getProfile
           let
               hdr :: ByteOff
    hdr         = Profile -> ByteOff
    fixedHdrSize Profile
    profile
               frame :: ByteOff
    frame       = ByteOff
    updfr ByteOff -> ByteOff -> ByteOff
    forall a. Num a => a -> a -> a
    + ByteOff
    hdr ByteOff -> ByteOff -> ByteOff
    forall a. Num a => a -> a -> a
    + PlatformConstants -> ByteOff
    pc_SIZEOF_StgUpdateFrame_NoHdr (Profile -> PlatformConstants
    profileConstants Profile
    profile)
           --
           CmmExpr -> CLabel -> CmmExpr -> FCode ()
    emitUpdateFrame (Area -> ByteOff -> CmmExpr
    CmmStackSlot Area
    Old ByteOff
    frame) CLabel
    lbl CmmExpr
    updatee
           ByteOff -> FCode () -> FCode ()
    forall a. ByteOff -> FCode a -> FCode a
    withUpdFrameOff ByteOff
    frame FCode ()
    body

    emitUpdateFrame :: CmmExpr -> CLabel -> CmmExpr -> FCode ()
    emitUpdateFrame :: CmmExpr -> CLabel -> CmmExpr -> FCode ()
    emitUpdateFrame CmmExpr
    frame CLabel
    lbl CmmExpr
    updatee = do
      Profile
    profile <- FCode Profile
    getProfile
      let
               hdr :: ByteOff
    hdr         = Profile -> ByteOff
    fixedHdrSize Profile
    profile
               off_updatee :: ByteOff
    off_updatee = ByteOff
    hdr ByteOff -> ByteOff -> ByteOff
    forall a. Num a => a -> a -> a
    + PlatformConstants -> ByteOff
    pc_OFFSET_StgUpdateFrame_updatee (Platform -> PlatformConstants
    platformConstants Platform
    platform)
               platform :: Platform
    platform    = Profile -> Platform
    profilePlatform Profile
    profile
      --
      CmmExpr -> CmmExpr -> FCode ()
    emitStore CmmExpr
    frame (CLabel -> CmmExpr
    mkLblExpr CLabel
    lbl)
      CmmExpr -> CmmExpr -> FCode ()
    emitStore (Platform -> CmmExpr -> ByteOff -> CmmExpr
    cmmOffset Platform
    platform CmmExpr
    frame ByteOff
    off_updatee) CmmExpr
    updatee
      CmmExpr -> FCode ()
    initUpdFrameProf CmmExpr
    frame

    -----------------------------------------------------------------------------
    -- Entering a CAF
    --
    -- See Note [CAF management] in rts/sm/Storage.c

    link_caf :: LocalReg           -- pointer to the closure
             -> FCode CmmExpr      -- Returns amode for closure to be updated
    -- This function returns the address of the black hole, so it can be
    -- updated with the new value when available.
    link_caf :: LocalReg -> FCode CmmExpr
    link_caf LocalReg
    node = do
      { Profile
    profile <- FCode Profile
    getProfile
            -- Call the RTS function newCAF, returning the newly-allocated
            -- blackhole indirection closure
      ; let newCAF_lbl :: CLabel
    newCAF_lbl = FastString
    -> Maybe ByteOff -> ForeignLabelSource -> FunctionOrData -> CLabel
    mkForeignLabel (String -> FastString
    fsLit String
    "newCAF") Maybe ByteOff
    forall a. Maybe a
    Nothing
                                        ForeignLabelSource
    ForeignLabelInExternalPackage FunctionOrData
    IsFunction
      ; let platform :: Platform
    platform = Profile -> Platform
    profilePlatform Profile
    profile
      ; LocalReg
    bh <- CmmType -> FCode LocalReg
    forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
    newTemp (Platform -> CmmType
    bWord Platform
    platform)
      ; [(LocalReg, ForeignHint)]
    -> CLabel -> [(CmmExpr, ForeignHint)] -> Bool -> FCode ()
    emitRtsCallGen [(LocalReg
    bh,ForeignHint
    AddrHint)] CLabel
    newCAF_lbl
          [ (CmmExpr
    baseExpr,  ForeignHint
    AddrHint),
            (CmmReg -> CmmExpr
    CmmReg (LocalReg -> CmmReg
    CmmLocal LocalReg
    node), ForeignHint
    AddrHint) ]
          Bool
    False

      -- see Note [atomic CAF entry] in rts/sm/Storage.c
      ; ByteOff
    updfr  <- FCode ByteOff
    getUpdFrameOff
      ; PtrOpts
    ptr_opts <- FCode PtrOpts
    getPtrOpts
      ; let target :: CmmExpr
    target = Platform -> CmmExpr -> CmmExpr
    entryCode Platform
    platform (PtrOpts -> CmmExpr -> CmmExpr
    closureInfoPtr PtrOpts
    ptr_opts (CmmReg -> CmmExpr
    CmmReg (LocalReg -> CmmReg
    CmmLocal LocalReg
    node)))
      ; CmmAGraph -> FCode ()
    emit (CmmAGraph -> FCode ()) -> FCode CmmAGraph -> FCode ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< CmmExpr -> CmmAGraph -> FCode CmmAGraph
    mkCmmIfThen
          (Platform -> CmmExpr -> CmmExpr -> CmmExpr
    cmmEqWord Platform
    platform (CmmReg -> CmmExpr
    CmmReg (LocalReg -> CmmReg
    CmmLocal LocalReg
    bh)) (Platform -> CmmExpr
    zeroExpr Platform
    platform))
            -- re-enter the CAF
           (Profile
    -> Convention -> CmmExpr -> [CmmExpr] -> ByteOff -> CmmAGraph
    mkJump Profile
    profile Convention
    NativeNodeCall CmmExpr
    target [] ByteOff
    updfr)

      ; CmmExpr -> FCode CmmExpr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmReg -> CmmExpr
    CmmReg (LocalReg -> CmmReg
    CmmLocal LocalReg
    bh)) }

    ------------------------------------------------------------------------
    --              Profiling
    ------------------------------------------------------------------------

    -- For "global" data constructors the description is simply occurrence
    -- name of the data constructor itself.  Otherwise it is determined by
    -- @closureDescription@ from the let binding information.

    closureDescription
       :: DynFlags
       -> Module            -- Module
       -> Name              -- Id of closure binding
       -> String
            -- Not called for StgRhsCon which have global info tables built in
            -- CgConTbls.hs with a description generated from the data constructor
    closureDescription :: DynFlags -> Module -> Name -> String
    closureDescription DynFlags
    dflags Module
    mod_name Name
    name
      = SDocContext -> SDoc -> String
    showSDocDump (DynFlags -> PprStyle -> SDocContext
    initSDocContext DynFlags
    dflags PprStyle
    defaultDumpStyle) (Char -> SDoc
    char Char
    '<' SDoc -> SDoc -> SDoc
    <>
                        (if Name -> Bool
    isExternalName Name
    name
                          then Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name -- ppr will include the module name prefix
                          else Module -> SDoc
    pprModule Module
    mod_name SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    '.' SDoc -> SDoc -> SDoc
    <> Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name) SDoc -> SDoc -> SDoc
    <>
                        Char -> SDoc
    char Char
    '>')
       -- showSDocDump, because we want to see the unique on the Name.