    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE PatternSynonyms #-}

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

    module GHC.StgToCmm.Monad (
            FCode,        -- type

            initC, runC, fixC,
            newUnique,

            emitLabel,

            emit, emitDecl,
            emitProcWithConvention, emitProcWithStackFrame,
            emitOutOfLine, emitAssign, emitStore, emitStore',
            emitComment, emitTick, emitUnwind,

            newTemp,

            getCmm, aGraphToGraph, getPlatform, getProfile,
            getCodeR, getCode, getCodeScoped, getHeapUsage,
            getCallOpts, getPtrOpts,

            mkCmmIfThenElse, mkCmmIfThen, mkCmmIfGoto,
            mkCmmIfThenElse', mkCmmIfThen', mkCmmIfGoto',

            mkCall, mkCmmCall,

            forkClosureBody, forkLneBody, forkAlts, forkAltPair, codeOnly,

            ConTagZ,

            Sequel(..), ReturnKind(..),
            withSequel, getSequel,

            setTickyCtrLabel, getTickyCtrLabel,
            tickScope, getTickScope,

            withUpdFrameOff, getUpdFrameOff, initUpdFrameOff,

            HeapUsage(..), VirtualHpOffset,        initHpUsage,
            getHpUsage,  setHpUsage, heapHWM,
            setVirtHp, getVirtHp, setRealHp,

            getModuleName,

            -- ideally we wouldn't export these, but some other modules access internal state
            getState, setState, getSelfLoop, withSelfLoop, getInfoDown, getDynFlags,

            -- more localised access to monad state
            CgIdInfo(..),
            getBinds, setBinds,
            -- out of general friendliness, we also export ...
            CgInfoDownwards(..), CgState(..) -- non-abstract
        ) where

    import GHC.Prelude hiding( sequence, succ )

    import GHC.Platform
    import GHC.Platform.Profile
    import GHC.Cmm
    import GHC.StgToCmm.Closure
    import GHC.Driver.Session
    import GHC.Cmm.Dataflow.Collections
    import GHC.Cmm.Graph as CmmGraph
    import GHC.Cmm.BlockId
    import GHC.Cmm.CLabel
    import GHC.Cmm.Info
    import GHC.Runtime.Heap.Layout
    import GHC.Unit
    import GHC.Types.Id
    import GHC.Types.Var.Env
    import GHC.Data.OrdList
    import GHC.Types.Basic( ConTagZ )
    import GHC.Types.Unique
    import GHC.Types.Unique.Supply
    import GHC.Data.FastString
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Utils.Misc
    import GHC.Exts (oneShot)

    import Control.Monad
    import Data.List (mapAccumL)

    --------------------------------------------------------
    -- The FCode monad and its types
    --
    -- FCode is the monad plumbed through the Stg->Cmm code generator, and
    -- the Cmm parser.  It contains the following things:
    --
    --  - A writer monad, collecting:
    --    - code for the current function, in the form of a CmmAGraph.
    --      The function "emit" appends more code to this.
    --    - the top-level CmmDecls accumulated so far
    --
    --  - A state monad with:
    --    - the local bindings in scope
    --    - the current heap usage
    --    - a UniqSupply
    --
    --  - A reader monad, for CgInfoDownwards, containing
    --    - DynFlags,
    --    - the current Module
    --    - the update-frame offset
    --    - the ticky counter label
    --    - the Sequel (the continuation to return to)
    --    - the self-recursive tail call information

    --------------------------------------------------------

    newtype FCode a = FCode' { forall a. FCode a -> CgInfoDownwards -> CgState -> (a, CgState)
    doFCode :: CgInfoDownwards -> CgState -> (a, CgState) }

    -- Not derived because of #18202.
    -- See Note [The one-shot state monad trick] in GHC.Utils.Monad
    instance Functor FCode where
      fmap :: forall a b. (a -> b) -> FCode a -> FCode b
    fmap a -> b
    f (FCode CgInfoDownwards -> CgState -> (a, CgState)
    m) =
        forall a. (CgInfoDownwards -> CgState -> (a, CgState)) -> FCode a
    FCode forall a b. (a -> b) -> a -> b
    $ \CgInfoDownwards
    info_down CgState
    state ->
          case CgInfoDownwards -> CgState -> (a, CgState)
    m CgInfoDownwards
    info_down CgState
    state of
            (a
    x, CgState
    state') -> (a -> b
    f a
    x, CgState
    state')

    -- This pattern synonym makes the simplifier monad eta-expand,
    -- which as a very beneficial effect on compiler performance
    -- See #18202.
    -- See Note [The one-shot state monad trick] in GHC.Utils.Monad
    {-# COMPLETE FCode #-}
    pattern FCode :: (CgInfoDownwards -> CgState -> (a, CgState))
                  -> FCode a
    pattern $mFCode :: forall {r} {a}.
    FCode a
    -> ((CgInfoDownwards -> CgState -> (a, CgState)) -> r)
    -> ((# #) -> r)
    -> r
    $bFCode :: forall a. (CgInfoDownwards -> CgState -> (a, CgState)) -> FCode a
    FCode m <- FCode' m
      where
        FCode CgInfoDownwards -> CgState -> (a, CgState)
    m = forall a. (CgInfoDownwards -> CgState -> (a, CgState)) -> FCode a
    FCode' forall a b. (a -> b) -> a -> b
    $ oneShot :: forall a b. (a -> b) -> a -> b
    oneShot (\CgInfoDownwards
    cgInfoDown -> oneShot :: forall a b. (a -> b) -> a -> b
    oneShot (\CgState
    state ->CgInfoDownwards -> CgState -> (a, CgState)
    m CgInfoDownwards
    cgInfoDown CgState
    state))

    instance Applicative FCode where
        pure :: forall a. a -> FCode a
    pure a
    val = forall a. (CgInfoDownwards -> CgState -> (a, CgState)) -> FCode a
    FCode (\CgInfoDownwards
    _info_down CgState
    state -> (a
    val, CgState
    state))
        {-# INLINE pure #-}
        <*> :: forall a b. FCode (a -> b) -> FCode a -> FCode b
    (<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    instance Monad FCode where
        FCode CgInfoDownwards -> CgState -> (a, CgState)
    m >>= :: forall a b. FCode a -> (a -> FCode b) -> FCode b
    >>= a -> FCode b
    k = forall a. (CgInfoDownwards -> CgState -> (a, CgState)) -> FCode a
    FCode forall a b. (a -> b) -> a -> b
    $
            \CgInfoDownwards
    info_down CgState
    state ->
                case CgInfoDownwards -> CgState -> (a, CgState)
    m CgInfoDownwards
    info_down CgState
    state of
                  (a
    m_result, CgState
    new_state) ->
                     case a -> FCode b
    k a
    m_result of
                       FCode CgInfoDownwards -> CgState -> (b, CgState)
    kcode -> CgInfoDownwards -> CgState -> (b, CgState)
    kcode CgInfoDownwards
    info_down CgState
    new_state
        {-# INLINE (>>=) #-}

    instance MonadUnique FCode where
      getUniqueSupplyM :: FCode UniqSupply
    getUniqueSupplyM = CgState -> UniqSupply
    cgs_uniqs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FCode CgState
    getState
      getUniqueM :: FCode Unique
    getUniqueM = forall a. (CgInfoDownwards -> CgState -> (a, CgState)) -> FCode a
    FCode forall a b. (a -> b) -> a -> b
    $ \CgInfoDownwards
    _ CgState
    st ->
        let (Unique
    u, UniqSupply
    us') = UniqSupply -> (Unique, UniqSupply)
    takeUniqFromSupply (CgState -> UniqSupply
    cgs_uniqs CgState
    st)
        in (Unique
    u, CgState
    st { cgs_uniqs :: UniqSupply
    cgs_uniqs = UniqSupply
    us' })

    initC :: IO CgState
    initC :: IO CgState
    initC  = do { UniqSupply
    uniqs <- Char -> IO UniqSupply
    mkSplitUniqSupply Char
    'c'
                ; forall (m :: * -> *) a. Monad m => a -> m a
    return (UniqSupply -> CgState
    initCgState UniqSupply
    uniqs) }

    runC :: DynFlags -> Module -> CgState -> FCode a -> (a,CgState)
    runC :: forall a. DynFlags -> Module -> CgState -> FCode a -> (a, CgState)
    runC DynFlags
    dflags Module
    mod CgState
    st FCode a
    fcode = forall a. FCode a -> CgInfoDownwards -> CgState -> (a, CgState)
    doFCode FCode a
    fcode (DynFlags -> Module -> CgInfoDownwards
    initCgInfoDown DynFlags
    dflags Module
    mod) CgState
    st

    fixC :: (a -> FCode a) -> FCode a
    fixC :: forall a. (a -> FCode a) -> FCode a
    fixC a -> FCode a
    fcode = forall a. (CgInfoDownwards -> CgState -> (a, CgState)) -> FCode a
    FCode forall a b. (a -> b) -> a -> b
    $
        \CgInfoDownwards
    info_down CgState
    state -> let (a
    v, CgState
    s) = forall a. FCode a -> CgInfoDownwards -> CgState -> (a, CgState)
    doFCode (a -> FCode a
    fcode a
    v) CgInfoDownwards
    info_down CgState
    state
                            in (a
    v, CgState
    s)

    --------------------------------------------------------
    --        The code generator environment
    --------------------------------------------------------

    -- This monadery has some information that it only passes
    -- *downwards*, as well as some ``state'' which is modified
    -- as we go along.

    data CgInfoDownwards        -- information only passed *downwards* by the monad
      = MkCgInfoDown {
            CgInfoDownwards -> DynFlags
    cgd_dflags    :: DynFlags,
            CgInfoDownwards -> Module
    cgd_mod       :: Module,            -- Module being compiled
            CgInfoDownwards -> VirtualHpOffset
    cgd_updfr_off :: UpdFrameOffset,    -- Size of current update frame
            CgInfoDownwards -> CLabel
    cgd_ticky     :: CLabel,            -- Current destination for ticky counts
            CgInfoDownwards -> Sequel
    cgd_sequel    :: Sequel,            -- What to do at end of basic block
            CgInfoDownwards -> Maybe SelfLoopInfo
    cgd_self_loop :: Maybe SelfLoopInfo,-- Which tail calls can be compiled
                                                -- as local jumps? See Note
                                                -- [Self-recursive tail calls] in
                                                -- GHC.StgToCmm.Expr
            CgInfoDownwards -> CmmTickScope
    cgd_tick_scope:: CmmTickScope       -- Tick scope for new blocks & ticks
      }

    type CgBindings = IdEnv CgIdInfo

    data CgIdInfo
      = CgIdInfo
            { CgIdInfo -> Id
    cg_id :: Id   -- Id that this is the info for
            , CgIdInfo -> LambdaFormInfo
    cg_lf  :: LambdaFormInfo
            , CgIdInfo -> CgLoc
    cg_loc :: CgLoc                     -- CmmExpr for the *tagged* value
            }

    instance OutputableP Platform CgIdInfo where
      pdoc :: Platform -> CgIdInfo -> SDoc
    pdoc Platform
    env (CgIdInfo { cg_id :: CgIdInfo -> Id
    cg_id = Id
    id, cg_loc :: CgIdInfo -> CgLoc
    cg_loc = CgLoc
    loc })
        = forall a. Outputable a => a -> SDoc
    ppr Id
    id SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "-->" SDoc -> SDoc -> SDoc
    <+> forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    env CgLoc
    loc

    -- Sequel tells what to do with the result of this expression
    data Sequel
      = Return              -- Return result(s) to continuation found on the stack.

      | AssignTo
            [LocalReg]      -- Put result(s) in these regs and fall through
                            -- NB: no void arguments here
                            --
            Bool            -- Should we adjust the heap pointer back to
                            -- recover space that's unused on this path?
                            -- We need to do this only if the expression
                            -- may allocate (e.g. it's a foreign call or
                            -- allocating primOp)

    instance Outputable Sequel where
        ppr :: Sequel -> SDoc
    ppr Sequel
    Return = String -> SDoc
    text String
    "Return"
        ppr (AssignTo [LocalReg]
    regs Bool
    b) = String -> SDoc
    text String
    "AssignTo" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr [LocalReg]
    regs SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Bool
    b

    -- See Note [sharing continuations] below
    data ReturnKind
      = AssignedDirectly
      | ReturnedTo BlockId ByteOff

    -- Note [sharing continuations]
    --
    -- ReturnKind says how the expression being compiled returned its
    -- results: either by assigning directly to the registers specified
    -- by the Sequel, or by returning to a continuation that does the
    -- assignments.  The point of this is we might be able to re-use the
    -- continuation in a subsequent heap-check.  Consider:
    --
    --    case f x of z
    --      True  -> <True code>
    --      False -> <False code>
    --
    -- Naively we would generate
    --
    --    R2 = x   -- argument to f
    --    Sp[young(L1)] = L1
    --    call f returns to L1
    --  L1:
    --    z = R1
    --    if (z & 1) then Ltrue else Lfalse
    --  Ltrue:
    --    Hp = Hp + 24
    --    if (Hp > HpLim) then L4 else L7
    --  L4:
    --    HpAlloc = 24
    --    goto L5
    --  L5:
    --    R1 = z
    --    Sp[young(L6)] = L6
    --    call stg_gc_unpt_r1 returns to L6
    --  L6:
    --    z = R1
    --    goto L1
    --  L7:
    --    <True code>
    --  Lfalse:
    --    <False code>
    --
    -- We want the gc call in L4 to return to L1, and discard L6.  Note
    -- that not only can we share L1 and L6, but the assignment of the
    -- return address in L4 is unnecessary because the return address for
    -- L1 is already on the stack.  We used to catch the sharing of L1 and
    -- L6 in the common-block-eliminator, but not the unnecessary return
    -- address assignment.
    --
    -- Since this case is so common I decided to make it more explicit and
    -- robust by programming the sharing directly, rather than relying on
    -- the common-block eliminator to catch it.  This makes
    -- common-block-elimination an optional optimisation, and furthermore
    -- generates less code in the first place that we have to subsequently
    -- clean up.
    --
    -- There are some rarer cases of common blocks that we don't catch
    -- this way, but that's ok.  Common-block-elimination is still available
    -- to catch them when optimisation is enabled.  Some examples are:
    --
    --   - when both the True and False branches do a heap check, we
    --     can share the heap-check failure code L4a and maybe L4
    --
    --   - in a case-of-case, there might be multiple continuations that
    --     we can common up.
    --
    -- It is always safe to use AssignedDirectly.  Expressions that jump
    -- to the continuation from multiple places (e.g. case expressions)
    -- fall back to AssignedDirectly.
    --

    initCgInfoDown :: DynFlags -> Module -> CgInfoDownwards
    initCgInfoDown :: DynFlags -> Module -> CgInfoDownwards
    initCgInfoDown DynFlags
    dflags Module
    mod
      = MkCgInfoDown { cgd_dflags :: DynFlags
    cgd_dflags    = DynFlags
    dflags
                     , cgd_mod :: Module
    cgd_mod       = Module
    mod
                     , cgd_updfr_off :: VirtualHpOffset
    cgd_updfr_off = Platform -> VirtualHpOffset
    initUpdFrameOff (DynFlags -> Platform
    targetPlatform DynFlags
    dflags)
                     , cgd_ticky :: CLabel
    cgd_ticky     = CLabel
    mkTopTickyCtrLabel
                     , cgd_sequel :: Sequel
    cgd_sequel    = Sequel
    initSequel
                     , cgd_self_loop :: Maybe SelfLoopInfo
    cgd_self_loop = forall a. Maybe a
    Nothing
                     , cgd_tick_scope :: CmmTickScope
    cgd_tick_scope= CmmTickScope
    GlobalScope }

    initSequel :: Sequel
    initSequel :: Sequel
    initSequel = Sequel
    Return

    initUpdFrameOff :: Platform -> UpdFrameOffset
    initUpdFrameOff :: Platform -> VirtualHpOffset
    initUpdFrameOff Platform
    platform = Platform -> VirtualHpOffset
    platformWordSizeInBytes Platform
    platform -- space for the RA

    --------------------------------------------------------
    --        The code generator state
    --------------------------------------------------------

    data CgState
      = MkCgState {
         CgState -> CmmAGraph
    cgs_stmts :: CmmAGraph,          -- Current procedure

         CgState -> OrdList CmmDecl
    cgs_tops  :: OrdList CmmDecl,
            -- Other procedures and data blocks in this compilation unit
            -- Both are ordered only so that we can
            -- reduce forward references, when it's easy to do so

         CgState -> CgBindings
    cgs_binds :: CgBindings,

         CgState -> HeapUsage
    cgs_hp_usg  :: HeapUsage,

         CgState -> UniqSupply
    cgs_uniqs :: UniqSupply }
    -- If you are wondering why you have to be careful forcing CgState then
    -- the reason is the knot-tying in 'getHeapUsage'. This problem is tracked
    -- in #19245

    data HeapUsage   -- See Note [Virtual and real heap pointers]
      = HeapUsage {
            HeapUsage -> VirtualHpOffset
    virtHp :: VirtualHpOffset,       -- Virtual offset of highest-allocated word
                                             --   Incremented whenever we allocate
            HeapUsage -> VirtualHpOffset
    realHp :: VirtualHpOffset        -- realHp: Virtual offset of real heap ptr
                                             --   Used in instruction addressing modes
        }

    type VirtualHpOffset = WordOff

    {- Note [Virtual and real heap pointers]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The code generator can allocate one or more objects contiguously, performing
    one heap check to cover allocation of all the objects at once.  Let's call
    this little chunk of heap space an "allocation chunk".  The code generator
    will emit code to
      * Perform a heap-exhaustion check
      * Move the heap pointer to the end of the allocation chunk
      * Allocate multiple objects within the chunk

    The code generator uses VirtualHpOffsets to address words within a
    single allocation chunk; these start at one and increase positively.
    The first word of the chunk has VirtualHpOffset=1, the second has
    VirtualHpOffset=2, and so on.

     * The field realHp tracks (the VirtualHpOffset) where the real Hp
       register is pointing.  Typically it'll be pointing to the end of the
       allocation chunk.

     * The field virtHp gives the VirtualHpOffset of the highest-allocated
       word so far.  It starts at zero (meaning no word has been allocated),
       and increases whenever an object is allocated.

    The difference between realHp and virtHp gives the offset from the
    real Hp register of a particular word in the allocation chunk. This
    is what getHpRelOffset does.  Since the returned offset is relative
    to the real Hp register, it is valid only until you change the real
    Hp register.  (Changing virtHp doesn't matter.)
    -}

    initCgState :: UniqSupply -> CgState
    initCgState :: UniqSupply -> CgState
    initCgState UniqSupply
    uniqs
      = MkCgState { cgs_stmts :: CmmAGraph
    cgs_stmts  = CmmAGraph
    mkNop
                  , cgs_tops :: OrdList CmmDecl
    cgs_tops   = forall a. OrdList a
    nilOL
                  , cgs_binds :: CgBindings
    cgs_binds  = forall a. VarEnv a
    emptyVarEnv
                  , cgs_hp_usg :: HeapUsage
    cgs_hp_usg = HeapUsage
    initHpUsage
                  , cgs_uniqs :: UniqSupply
    cgs_uniqs  = UniqSupply
    uniqs }

    stateIncUsage :: CgState -> CgState -> CgState
    -- stateIncUsage@ e1 e2 incorporates in e1
    -- the heap high water mark found in e2.
    stateIncUsage :: CgState -> CgState -> CgState
    stateIncUsage CgState
    s1 s2 :: CgState
    s2@(MkCgState { cgs_hp_usg :: CgState -> HeapUsage
    cgs_hp_usg = HeapUsage
    hp_usg })
         = CgState
    s1 { cgs_hp_usg :: HeapUsage
    cgs_hp_usg  = CgState -> HeapUsage
    cgs_hp_usg  CgState
    s1 HeapUsage -> VirtualHpOffset -> HeapUsage
    `maxHpHw`  HeapUsage -> VirtualHpOffset
    virtHp HeapUsage
    hp_usg }
           CgState -> CgState -> CgState
    `addCodeBlocksFrom` CgState
    s2

    addCodeBlocksFrom :: CgState -> CgState -> CgState
    -- Add code blocks from the latter to the former
    -- (The cgs_stmts will often be empty, but not always; see codeOnly)
    CgState
    s1 addCodeBlocksFrom :: CgState -> CgState -> CgState
    `addCodeBlocksFrom` CgState
    s2
      = CgState
    s1 { cgs_stmts :: CmmAGraph
    cgs_stmts = CgState -> CmmAGraph
    cgs_stmts CgState
    s1 CmmAGraph -> CmmAGraph -> CmmAGraph
    CmmGraph.<*> CgState -> CmmAGraph
    cgs_stmts CgState
    s2,
             cgs_tops :: OrdList CmmDecl
    cgs_tops  = CgState -> OrdList CmmDecl
    cgs_tops  CgState
    s1 forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` CgState -> OrdList CmmDecl
    cgs_tops  CgState
    s2 }

    -- The heap high water mark is the larger of virtHp and hwHp.  The latter is
    -- only records the high water marks of forked-off branches, so to find the
    -- heap high water mark you have to take the max of virtHp and hwHp.  Remember,
    -- virtHp never retreats!
    --
    -- Note Jan 04: ok, so why do we only look at the virtual Hp??

    heapHWM :: HeapUsage -> VirtualHpOffset
    heapHWM :: HeapUsage -> VirtualHpOffset
    heapHWM = HeapUsage -> VirtualHpOffset
    virtHp

    initHpUsage :: HeapUsage
    initHpUsage :: HeapUsage
    initHpUsage = HeapUsage { virtHp :: VirtualHpOffset
    virtHp = VirtualHpOffset
    0, realHp :: VirtualHpOffset
    realHp = VirtualHpOffset
    0 }

    maxHpHw :: HeapUsage -> VirtualHpOffset -> HeapUsage
    HeapUsage
    hp_usg maxHpHw :: HeapUsage -> VirtualHpOffset -> HeapUsage
    `maxHpHw` VirtualHpOffset
    hw = HeapUsage
    hp_usg { virtHp :: VirtualHpOffset
    virtHp = HeapUsage -> VirtualHpOffset
    virtHp HeapUsage
    hp_usg forall a. Ord a => a -> a -> a
    `max` VirtualHpOffset
    hw }

    --------------------------------------------------------
    -- Operators for getting and setting the state and "info_down".
    --------------------------------------------------------

    getState :: FCode CgState
    getState :: FCode CgState
    getState = forall a. (CgInfoDownwards -> CgState -> (a, CgState)) -> FCode a
    FCode forall a b. (a -> b) -> a -> b
    $ \CgInfoDownwards
    _info_down CgState
    state -> (CgState
    state, CgState
    state)

    setState :: CgState -> FCode ()
    setState :: CgState -> FCode ()
    setState CgState
    state = forall a. (CgInfoDownwards -> CgState -> (a, CgState)) -> FCode a
    FCode forall a b. (a -> b) -> a -> b
    $ \CgInfoDownwards
    _info_down CgState
    _ -> ((), CgState
    state)

    getHpUsage :: FCode HeapUsage
    getHpUsage :: FCode HeapUsage
    getHpUsage = do
            CgState
    state <- FCode CgState
    getState
            forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ CgState -> HeapUsage
    cgs_hp_usg CgState
    state

    setHpUsage :: HeapUsage -> FCode ()
    setHpUsage :: HeapUsage -> FCode ()
    setHpUsage HeapUsage
    new_hp_usg = do
            CgState
    state <- FCode CgState
    getState
            CgState -> FCode ()
    setState forall a b. (a -> b) -> a -> b
    $ CgState
    state {cgs_hp_usg :: HeapUsage
    cgs_hp_usg = HeapUsage
    new_hp_usg}

    setVirtHp :: VirtualHpOffset -> FCode ()
    setVirtHp :: VirtualHpOffset -> FCode ()
    setVirtHp VirtualHpOffset
    new_virtHp
      = do  { HeapUsage
    hp_usage <- FCode HeapUsage
    getHpUsage
            ; HeapUsage -> FCode ()
    setHpUsage (HeapUsage
    hp_usage {virtHp :: VirtualHpOffset
    virtHp = VirtualHpOffset
    new_virtHp}) }

    getVirtHp :: FCode VirtualHpOffset
    getVirtHp :: FCode VirtualHpOffset
    getVirtHp
      = do  { HeapUsage
    hp_usage <- FCode HeapUsage
    getHpUsage
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (HeapUsage -> VirtualHpOffset
    virtHp HeapUsage
    hp_usage) }

    setRealHp ::  VirtualHpOffset -> FCode ()
    setRealHp :: VirtualHpOffset -> FCode ()
    setRealHp VirtualHpOffset
    new_realHp
      = do  { HeapUsage
    hp_usage <- FCode HeapUsage
    getHpUsage
            ; HeapUsage -> FCode ()
    setHpUsage (HeapUsage
    hp_usage {realHp :: VirtualHpOffset
    realHp = VirtualHpOffset
    new_realHp}) }

    getBinds :: FCode CgBindings
    getBinds :: FCode CgBindings
    getBinds = do
            CgState
    state <- FCode CgState
    getState
            forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ CgState -> CgBindings
    cgs_binds CgState
    state

    setBinds :: CgBindings -> FCode ()
    setBinds :: CgBindings -> FCode ()
    setBinds CgBindings
    new_binds = do
            CgState
    state <- FCode CgState
    getState
            CgState -> FCode ()
    setState forall a b. (a -> b) -> a -> b
    $ CgState
    state {cgs_binds :: CgBindings
    cgs_binds = CgBindings
    new_binds}

    withState :: FCode a -> CgState -> FCode (a,CgState)
    withState :: forall a. FCode a -> CgState -> FCode (a, CgState)
    withState (FCode CgInfoDownwards -> CgState -> (a, CgState)
    fcode) CgState
    newstate = forall a. (CgInfoDownwards -> CgState -> (a, CgState)) -> FCode a
    FCode forall a b. (a -> b) -> a -> b
    $ \CgInfoDownwards
    info_down CgState
    state ->
      case CgInfoDownwards -> CgState -> (a, CgState)
    fcode CgInfoDownwards
    info_down CgState
    newstate of
        (a
    retval, CgState
    state2) -> ((a
    retval,CgState
    state2), CgState
    state)

    newUniqSupply :: FCode UniqSupply
    newUniqSupply :: FCode UniqSupply
    newUniqSupply = do
            CgState
    state <- FCode CgState
    getState
            let (UniqSupply
    us1, UniqSupply
    us2) = UniqSupply -> (UniqSupply, UniqSupply)
    splitUniqSupply (CgState -> UniqSupply
    cgs_uniqs CgState
    state)
            CgState -> FCode ()
    setState forall a b. (a -> b) -> a -> b
    $ CgState
    state { cgs_uniqs :: UniqSupply
    cgs_uniqs = UniqSupply
    us1 }
            forall (m :: * -> *) a. Monad m => a -> m a
    return UniqSupply
    us2

    newUnique :: FCode Unique
    newUnique :: FCode Unique
    newUnique = do
            CgState
    state <- FCode CgState
    getState
            let (Unique
    u,UniqSupply
    us') = UniqSupply -> (Unique, UniqSupply)
    takeUniqFromSupply (CgState -> UniqSupply
    cgs_uniqs CgState
    state)
            CgState -> FCode ()
    setState forall a b. (a -> b) -> a -> b
    $ CgState
    state { cgs_uniqs :: UniqSupply
    cgs_uniqs = UniqSupply
    us' }
            forall (m :: * -> *) a. Monad m => a -> m a
    return Unique
    u

    newTemp :: MonadUnique m => CmmType -> m LocalReg
    newTemp :: forall (m :: * -> *). MonadUnique m => CmmType -> m LocalReg
    newTemp CmmType
    rep = do { Unique
    uniq <- forall (m :: * -> *). MonadUnique m => m Unique
    getUniqueM
                     ; forall (m :: * -> *) a. Monad m => a -> m a
    return (Unique -> CmmType -> LocalReg
    LocalReg Unique
    uniq CmmType
    rep) }

    ------------------
    getInfoDown :: FCode CgInfoDownwards
    getInfoDown :: FCode CgInfoDownwards
    getInfoDown = forall a. (CgInfoDownwards -> CgState -> (a, CgState)) -> FCode a
    FCode forall a b. (a -> b) -> a -> b
    $ \CgInfoDownwards
    info_down CgState
    state -> (CgInfoDownwards
    info_down,CgState
    state)

    getSelfLoop :: FCode (Maybe SelfLoopInfo)
    getSelfLoop :: FCode (Maybe SelfLoopInfo)
    getSelfLoop = do
            CgInfoDownwards
    info_down <- FCode CgInfoDownwards
    getInfoDown
            forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ CgInfoDownwards -> Maybe SelfLoopInfo
    cgd_self_loop CgInfoDownwards
    info_down

    withSelfLoop :: SelfLoopInfo -> FCode a -> FCode a
    withSelfLoop :: forall a. SelfLoopInfo -> FCode a -> FCode a
    withSelfLoop SelfLoopInfo
    self_loop FCode a
    code = do
            CgInfoDownwards
    info_down <- FCode CgInfoDownwards
    getInfoDown
            forall a. FCode a -> CgInfoDownwards -> FCode a
    withInfoDown FCode a
    code (CgInfoDownwards
    info_down {cgd_self_loop :: Maybe SelfLoopInfo
    cgd_self_loop = forall a. a -> Maybe a
    Just SelfLoopInfo
    self_loop})

    instance HasDynFlags FCode where
        getDynFlags :: FCode DynFlags
    getDynFlags = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM CgInfoDownwards -> DynFlags
    cgd_dflags FCode CgInfoDownwards
    getInfoDown

    getProfile :: FCode Profile
    getProfile :: FCode Profile
    getProfile = DynFlags -> Profile
    targetProfile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags

    getPlatform :: FCode Platform
    getPlatform :: FCode Platform
    getPlatform = Profile -> Platform
    profilePlatform forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FCode Profile
    getProfile

    getCallOpts :: FCode CallOpts
    getCallOpts :: FCode CallOpts
    getCallOpts = do
       DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
       Profile
    profile <- FCode Profile
    getProfile
       forall (f :: * -> *) a. Applicative f => a -> f a
    pure forall a b. (a -> b) -> a -> b
    $ CallOpts
        { co_profile :: Profile
    co_profile       = Profile
    profile
        , co_loopification :: Bool
    co_loopification = GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_Loopification DynFlags
    dflags
        , co_ticky :: Bool
    co_ticky         = GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_Ticky DynFlags
    dflags
        }

    getPtrOpts :: FCode PtrOpts
    getPtrOpts :: FCode PtrOpts
    getPtrOpts = do
       DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
       Profile
    profile <- FCode Profile
    getProfile
       forall (f :: * -> *) a. Applicative f => a -> f a
    pure forall a b. (a -> b) -> a -> b
    $ PtrOpts
          { po_profile :: Profile
    po_profile     = Profile
    profile
          , po_align_check :: Bool
    po_align_check = GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_AlignmentSanitisation DynFlags
    dflags
          }

    withInfoDown :: FCode a -> CgInfoDownwards -> FCode a
    withInfoDown :: forall a. FCode a -> CgInfoDownwards -> FCode a
    withInfoDown (FCode CgInfoDownwards -> CgState -> (a, CgState)
    fcode) CgInfoDownwards
    info_down = forall a. (CgInfoDownwards -> CgState -> (a, CgState)) -> FCode a
    FCode forall a b. (a -> b) -> a -> b
    $ \CgInfoDownwards
    _ CgState
    state -> CgInfoDownwards -> CgState -> (a, CgState)
    fcode CgInfoDownwards
    info_down CgState
    state

    -- ----------------------------------------------------------------------------
    -- Get the current module name

    getModuleName :: FCode Module
    getModuleName :: FCode Module
    getModuleName = do { CgInfoDownwards
    info <- FCode CgInfoDownwards
    getInfoDown; forall (m :: * -> *) a. Monad m => a -> m a
    return (CgInfoDownwards -> Module
    cgd_mod CgInfoDownwards
    info) }

    -- ----------------------------------------------------------------------------
    -- Get/set the end-of-block info

    withSequel :: Sequel -> FCode a -> FCode a
    withSequel :: forall a. Sequel -> FCode a -> FCode a
    withSequel Sequel
    sequel FCode a
    code
      = do  { CgInfoDownwards
    info  <- FCode CgInfoDownwards
    getInfoDown
            ; forall a. FCode a -> CgInfoDownwards -> FCode a
    withInfoDown FCode a
    code (CgInfoDownwards
    info {cgd_sequel :: Sequel
    cgd_sequel = Sequel
    sequel, cgd_self_loop :: Maybe SelfLoopInfo
    cgd_self_loop = forall a. Maybe a
    Nothing }) }

    getSequel :: FCode Sequel
    getSequel :: FCode Sequel
    getSequel = do  { CgInfoDownwards
    info <- FCode CgInfoDownwards
    getInfoDown
                    ; forall (m :: * -> *) a. Monad m => a -> m a
    return (CgInfoDownwards -> Sequel
    cgd_sequel CgInfoDownwards
    info) }

    -- ----------------------------------------------------------------------------
    -- Get/set the size of the update frame

    -- We keep track of the size of the update frame so that we
    -- can set the stack pointer to the proper address on return
    -- (or tail call) from the closure.
    -- There should be at most one update frame for each closure.
    -- Note: I'm including the size of the original return address
    -- in the size of the update frame -- hence the default case on `get'.

    withUpdFrameOff :: UpdFrameOffset -> FCode a -> FCode a
    withUpdFrameOff :: forall a. VirtualHpOffset -> FCode a -> FCode a
    withUpdFrameOff VirtualHpOffset
    size FCode a
    code
      = do  { CgInfoDownwards
    info  <- FCode CgInfoDownwards
    getInfoDown
            ; forall a. FCode a -> CgInfoDownwards -> FCode a
    withInfoDown FCode a
    code (CgInfoDownwards
    info {cgd_updfr_off :: VirtualHpOffset
    cgd_updfr_off = VirtualHpOffset
    size }) }

    getUpdFrameOff :: FCode UpdFrameOffset
    getUpdFrameOff :: FCode VirtualHpOffset
    getUpdFrameOff
      = do  { CgInfoDownwards
    info  <- FCode CgInfoDownwards
    getInfoDown
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ CgInfoDownwards -> VirtualHpOffset
    cgd_updfr_off CgInfoDownwards
    info }

    -- ----------------------------------------------------------------------------
    -- Get/set the current ticky counter label

    getTickyCtrLabel :: FCode CLabel
    getTickyCtrLabel :: FCode CLabel
    getTickyCtrLabel = do
            CgInfoDownwards
    info <- FCode CgInfoDownwards
    getInfoDown
            forall (m :: * -> *) a. Monad m => a -> m a
    return (CgInfoDownwards -> CLabel
    cgd_ticky CgInfoDownwards
    info)

    setTickyCtrLabel :: CLabel -> FCode a -> FCode a
    setTickyCtrLabel :: forall a. CLabel -> FCode a -> FCode a
    setTickyCtrLabel CLabel
    ticky FCode a
    code = do
            CgInfoDownwards
    info <- FCode CgInfoDownwards
    getInfoDown
            forall a. FCode a -> CgInfoDownwards -> FCode a
    withInfoDown FCode a
    code (CgInfoDownwards
    info {cgd_ticky :: CLabel
    cgd_ticky = CLabel
    ticky})

    -- ----------------------------------------------------------------------------
    -- Manage tick scopes

    -- | The current tick scope. We will assign this to generated blocks.
    getTickScope :: FCode CmmTickScope
    getTickScope :: FCode CmmTickScope
    getTickScope = do
            CgInfoDownwards
    info <- FCode CgInfoDownwards
    getInfoDown
            forall (m :: * -> *) a. Monad m => a -> m a
    return (CgInfoDownwards -> CmmTickScope
    cgd_tick_scope CgInfoDownwards
    info)

    -- | Places blocks generated by the given code into a fresh
    -- (sub-)scope. This will make sure that Cmm annotations in our scope
    -- will apply to the Cmm blocks generated therein - but not the other
    -- way around.
    tickScope :: FCode a -> FCode a
    tickScope :: forall a. FCode a -> FCode a
    tickScope FCode a
    code = do
            CgInfoDownwards
    info <- FCode CgInfoDownwards
    getInfoDown
            if DynFlags -> VirtualHpOffset
    debugLevel (CgInfoDownwards -> DynFlags
    cgd_dflags CgInfoDownwards
    info) forall a. Eq a => a -> a -> Bool
    == VirtualHpOffset
    0 then FCode a
    code else do
              Unique
    u <- FCode Unique
    newUnique
              let scope' :: CmmTickScope
    scope' = Unique -> CmmTickScope -> CmmTickScope
    SubScope Unique
    u (CgInfoDownwards -> CmmTickScope
    cgd_tick_scope CgInfoDownwards
    info)
              forall a. FCode a -> CgInfoDownwards -> FCode a
    withInfoDown FCode a
    code CgInfoDownwards
    info{ cgd_tick_scope :: CmmTickScope
    cgd_tick_scope = CmmTickScope
    scope' }

    --------------------------------------------------------
    --                 Forking
    --------------------------------------------------------

    forkClosureBody :: FCode () -> FCode ()
    -- forkClosureBody compiles body_code in environment where:
    --   - sequel, update stack frame and self loop info are
    --     set to fresh values
    --   - state is set to a fresh value, except for local bindings
    --     that are passed in unchanged. It's up to the enclosed code to
    --     re-bind the free variables to a field of the closure.

    forkClosureBody :: FCode () -> FCode ()
    forkClosureBody FCode ()
    body_code
      = do  { Platform
    platform <- FCode Platform
    getPlatform
            ; CgInfoDownwards
    info   <- FCode CgInfoDownwards
    getInfoDown
            ; UniqSupply
    us     <- FCode UniqSupply
    newUniqSupply
            ; CgState
    state  <- FCode CgState
    getState
            ; let body_info_down :: CgInfoDownwards
    body_info_down = CgInfoDownwards
    info { cgd_sequel :: Sequel
    cgd_sequel    = Sequel
    initSequel
                                        , cgd_updfr_off :: VirtualHpOffset
    cgd_updfr_off = Platform -> VirtualHpOffset
    initUpdFrameOff Platform
    platform
                                        , cgd_self_loop :: Maybe SelfLoopInfo
    cgd_self_loop = forall a. Maybe a
    Nothing }
                  fork_state_in :: CgState
    fork_state_in = (UniqSupply -> CgState
    initCgState UniqSupply
    us) { cgs_binds :: CgBindings
    cgs_binds = CgState -> CgBindings
    cgs_binds CgState
    state }
                  ((),CgState
    fork_state_out) = forall a. FCode a -> CgInfoDownwards -> CgState -> (a, CgState)
    doFCode FCode ()
    body_code CgInfoDownwards
    body_info_down CgState
    fork_state_in
            ; CgState -> FCode ()
    setState forall a b. (a -> b) -> a -> b
    $ CgState
    state CgState -> CgState -> CgState
    `addCodeBlocksFrom` CgState
    fork_state_out }

    forkLneBody :: FCode a -> FCode a
    -- 'forkLneBody' takes a body of let-no-escape binding and compiles
    -- it in the *current* environment, returning the graph thus constructed.
    --
    -- The current environment is passed on completely unchanged to
    -- the successor.  In particular, any heap usage from the enclosed
    -- code is discarded; it should deal with its own heap consumption.
    forkLneBody :: forall a. FCode a -> FCode a
    forkLneBody FCode a
    body_code
      = do  { CgInfoDownwards
    info_down <- FCode CgInfoDownwards
    getInfoDown
            ; UniqSupply
    us        <- FCode UniqSupply
    newUniqSupply
            ; CgState
    state     <- FCode CgState
    getState
            ; let fork_state_in :: CgState
    fork_state_in = (UniqSupply -> CgState
    initCgState UniqSupply
    us) { cgs_binds :: CgBindings
    cgs_binds = CgState -> CgBindings
    cgs_binds CgState
    state }
                  (a
    result, CgState
    fork_state_out) = forall a. FCode a -> CgInfoDownwards -> CgState -> (a, CgState)
    doFCode FCode a
    body_code CgInfoDownwards
    info_down CgState
    fork_state_in
            ; CgState -> FCode ()
    setState forall a b. (a -> b) -> a -> b
    $ CgState
    state CgState -> CgState -> CgState
    `addCodeBlocksFrom` CgState
    fork_state_out
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return a
    result }

    codeOnly :: FCode () -> FCode ()
    -- Emit any code from the inner thing into the outer thing
    -- Do not affect anything else in the outer state
    -- Used in almost-circular code to prevent false loop dependencies
    codeOnly :: FCode () -> FCode ()
    codeOnly FCode ()
    body_code
      = do  { CgInfoDownwards
    info_down <- FCode CgInfoDownwards
    getInfoDown
            ; UniqSupply
    us        <- FCode UniqSupply
    newUniqSupply
            ; CgState
    state     <- FCode CgState
    getState
            ; let   fork_state_in :: CgState
    fork_state_in = (UniqSupply -> CgState
    initCgState UniqSupply
    us) { cgs_binds :: CgBindings
    cgs_binds   = CgState -> CgBindings
    cgs_binds CgState
    state
                                                     , cgs_hp_usg :: HeapUsage
    cgs_hp_usg  = CgState -> HeapUsage
    cgs_hp_usg CgState
    state }
                    ((), CgState
    fork_state_out) = forall a. FCode a -> CgInfoDownwards -> CgState -> (a, CgState)
    doFCode FCode ()
    body_code CgInfoDownwards
    info_down CgState
    fork_state_in
            ; CgState -> FCode ()
    setState forall a b. (a -> b) -> a -> b
    $ CgState
    state CgState -> CgState -> CgState
    `addCodeBlocksFrom` CgState
    fork_state_out }

    forkAlts :: [FCode a] -> FCode [a]
    -- (forkAlts' bs d) takes fcodes 'bs' for the branches of a 'case', and
    -- an fcode for the default case 'd', and compiles each in the current
    -- environment.  The current environment is passed on unmodified, except
    -- that the virtual Hp is moved on to the worst virtual Hp for the branches

    forkAlts :: forall a. [FCode a] -> FCode [a]
    forkAlts [FCode a]
    branch_fcodes
      = do  { CgInfoDownwards
    info_down <- FCode CgInfoDownwards
    getInfoDown
            ; UniqSupply
    us <- FCode UniqSupply
    newUniqSupply
            ; CgState
    state <- FCode CgState
    getState
            ; let compile :: UniqSupply -> FCode a -> (UniqSupply, (a, CgState))
    compile UniqSupply
    us FCode a
    branch
                    = (UniqSupply
    us2, forall a. FCode a -> CgInfoDownwards -> CgState -> (a, CgState)
    doFCode FCode a
    branch CgInfoDownwards
    info_down CgState
    branch_state)
                    where
                      (UniqSupply
    us1,UniqSupply
    us2) = UniqSupply -> (UniqSupply, UniqSupply)
    splitUniqSupply UniqSupply
    us
                      branch_state :: CgState
    branch_state = (UniqSupply -> CgState
    initCgState UniqSupply
    us1) {
                                            cgs_binds :: CgBindings
    cgs_binds  = CgState -> CgBindings
    cgs_binds CgState
    state
                                          , cgs_hp_usg :: HeapUsage
    cgs_hp_usg = CgState -> HeapUsage
    cgs_hp_usg CgState
    state }
                  (UniqSupply
    _us, [(a, CgState)]
    results) = forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL UniqSupply -> FCode a -> (UniqSupply, (a, CgState))
    compile UniqSupply
    us [FCode a]
    branch_fcodes
                  ([a]
    branch_results, [CgState]
    branch_out_states) = forall a b. [(a, b)] -> ([a], [b])
    unzip [(a, CgState)]
    results
            ; CgState -> FCode ()
    setState forall a b. (a -> b) -> a -> b
    $ forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' CgState -> CgState -> CgState
    stateIncUsage CgState
    state [CgState]
    branch_out_states
                    -- NB foldl.  state is the *left* argument to stateIncUsage
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return [a]
    branch_results }

    forkAltPair :: FCode a -> FCode a -> FCode (a,a)
    -- Most common use of 'forkAlts'; having this helper function avoids
    -- accidental use of failible pattern-matches in @do@-notation
    forkAltPair :: forall a. FCode a -> FCode a -> FCode (a, a)
    forkAltPair FCode a
    x FCode a
    y = do
      [a]
    xy' <- forall a. [FCode a] -> FCode [a]
    forkAlts [FCode a
    x,FCode a
    y]
      case [a]
    xy' of
        [a
    x',a
    y'] -> forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    x',a
    y')
        [a]
    _ -> forall a. String -> a
    panic String
    "forkAltPair"

    -- collect the code emitted by an FCode computation
    getCodeR :: FCode a -> FCode (a, CmmAGraph)
    getCodeR :: forall a. FCode a -> FCode (a, CmmAGraph)
    getCodeR FCode a
    fcode
      = do  { CgState
    state1 <- FCode CgState
    getState
            ; (a
    a, CgState
    state2) <- forall a. FCode a -> CgState -> FCode (a, CgState)
    withState FCode a
    fcode (CgState
    state1 { cgs_stmts :: CmmAGraph
    cgs_stmts = CmmAGraph
    mkNop })
            ; CgState -> FCode ()
    setState forall a b. (a -> b) -> a -> b
    $ CgState
    state2 { cgs_stmts :: CmmAGraph
    cgs_stmts = CgState -> CmmAGraph
    cgs_stmts CgState
    state1  }
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    a, CgState -> CmmAGraph
    cgs_stmts CgState
    state2) }

    getCode :: FCode a -> FCode CmmAGraph
    getCode :: forall a. FCode a -> FCode CmmAGraph
    getCode FCode a
    fcode = do { (a
    _,CmmAGraph
    stmts) <- forall a. FCode a -> FCode (a, CmmAGraph)
    getCodeR FCode a
    fcode; forall (m :: * -> *) a. Monad m => a -> m a
    return CmmAGraph
    stmts }

    -- | Generate code into a fresh tick (sub-)scope and gather generated code
    getCodeScoped :: FCode a -> FCode (a, CmmAGraphScoped)
    getCodeScoped :: forall a. FCode a -> FCode (a, CmmAGraphScoped)
    getCodeScoped FCode a
    fcode
      = do  { CgState
    state1 <- FCode CgState
    getState
            ; ((a
    a, CmmTickScope
    tscope), CgState
    state2) <-
                forall a. FCode a -> FCode a
    tickScope forall a b. (a -> b) -> a -> b
    $
                forall a b c. (a -> b -> c) -> b -> a -> c
    flip forall a. FCode a -> CgState -> FCode (a, CgState)
    withState CgState
    state1 { cgs_stmts :: CmmAGraph
    cgs_stmts = CmmAGraph
    mkNop } forall a b. (a -> b) -> a -> b
    $
                do { a
    a   <- FCode a
    fcode
                   ; CmmTickScope
    scp <- FCode CmmTickScope
    getTickScope
                   ; forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    a, CmmTickScope
    scp) }
            ; CgState -> FCode ()
    setState forall a b. (a -> b) -> a -> b
    $ CgState
    state2 { cgs_stmts :: CmmAGraph
    cgs_stmts = CgState -> CmmAGraph
    cgs_stmts CgState
    state1  }
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    a, (CgState -> CmmAGraph
    cgs_stmts CgState
    state2, CmmTickScope
    tscope)) }

    -- 'getHeapUsage' applies a function to the amount of heap that it uses.
    -- It initialises the heap usage to zeros, and passes on an unchanged
    -- heap usage.
    --
    -- It is usually a prelude to performing a GC check, so everything must
    -- be in a tidy and consistent state.
    --
    -- Note the slightly subtle fixed point behaviour needed here

    getHeapUsage :: (VirtualHpOffset -> FCode a) -> FCode a
    getHeapUsage :: forall a. (VirtualHpOffset -> FCode a) -> FCode a
    getHeapUsage VirtualHpOffset -> FCode a
    fcode
      = do  { CgInfoDownwards
    info_down <- FCode CgInfoDownwards
    getInfoDown
            ; CgState
    state <- FCode CgState
    getState
            ; let   fstate_in :: CgState
    fstate_in = CgState
    state { cgs_hp_usg :: HeapUsage
    cgs_hp_usg  = HeapUsage
    initHpUsage }
                    (a
    r, CgState
    fstate_out) = forall a. FCode a -> CgInfoDownwards -> CgState -> (a, CgState)
    doFCode (VirtualHpOffset -> FCode a
    fcode VirtualHpOffset
    hp_hw) CgInfoDownwards
    info_down CgState
    fstate_in
                    hp_hw :: VirtualHpOffset
    hp_hw = HeapUsage -> VirtualHpOffset
    heapHWM (CgState -> HeapUsage
    cgs_hp_usg CgState
    fstate_out)        -- Loop here!

            ; CgState -> FCode ()
    setState forall a b. (a -> b) -> a -> b
    $ CgState
    fstate_out { cgs_hp_usg :: HeapUsage
    cgs_hp_usg = CgState -> HeapUsage
    cgs_hp_usg CgState
    state }
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return a
    r }

    -- ----------------------------------------------------------------------------
    -- Combinators for emitting code

    emitCgStmt :: CgStmt -> FCode ()
    emitCgStmt :: CgStmt -> FCode ()
    emitCgStmt CgStmt
    stmt
      = do  { CgState
    state <- FCode CgState
    getState
            ; CgState -> FCode ()
    setState forall a b. (a -> b) -> a -> b
    $ CgState
    state { cgs_stmts :: CmmAGraph
    cgs_stmts = CgState -> CmmAGraph
    cgs_stmts CgState
    state forall a. OrdList a -> a -> OrdList a
    `snocOL` CgStmt
    stmt }
            }

    emitLabel :: BlockId -> FCode ()
    emitLabel :: BlockId -> FCode ()
    emitLabel BlockId
    id = do CmmTickScope
    tscope <- FCode CmmTickScope
    getTickScope
                      CgStmt -> FCode ()
    emitCgStmt (BlockId -> CmmTickScope -> CgStmt
    CgLabel BlockId
    id CmmTickScope
    tscope)

    emitComment :: FastString -> FCode ()
    emitComment :: FastString -> FCode ()
    emitComment FastString
    s
      | Bool
    debugIsOn = CgStmt -> FCode ()
    emitCgStmt (CmmNode O O -> CgStmt
    CgStmt (FastString -> CmmNode O O
    CmmComment FastString
    s))
      | Bool
    otherwise = forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    emitTick :: CmmTickish -> FCode ()
    emitTick :: CmmTickish -> FCode ()
    emitTick = CgStmt -> FCode ()
    emitCgStmt forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CmmNode O O -> CgStmt
    CgStmt forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CmmTickish -> CmmNode O O
    CmmTick

    emitUnwind :: [(GlobalReg, Maybe CmmExpr)] -> FCode ()
    emitUnwind :: [(GlobalReg, Maybe CmmExpr)] -> FCode ()
    emitUnwind [(GlobalReg, Maybe CmmExpr)]
    regs = do
      DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (DynFlags -> VirtualHpOffset
    debugLevel DynFlags
    dflags forall a. Ord a => a -> a -> Bool
    > VirtualHpOffset
    0) forall a b. (a -> b) -> a -> b
    $
         CgStmt -> FCode ()
    emitCgStmt forall a b. (a -> b) -> a -> b
    $ CmmNode O O -> CgStmt
    CgStmt forall a b. (a -> b) -> a -> b
    $ [(GlobalReg, Maybe CmmExpr)] -> CmmNode O O
    CmmUnwind [(GlobalReg, Maybe CmmExpr)]
    regs

    emitAssign :: CmmReg  -> CmmExpr -> FCode ()
    emitAssign :: CmmReg -> CmmExpr -> FCode ()
    emitAssign CmmReg
    l CmmExpr
    r = CgStmt -> FCode ()
    emitCgStmt (CmmNode O O -> CgStmt
    CgStmt (CmmReg -> CmmExpr -> CmmNode O O
    CmmAssign CmmReg
    l CmmExpr
    r))

    -- | Assumes natural alignment.
    emitStore :: CmmExpr -> CmmExpr -> FCode ()
    emitStore :: CmmExpr -> CmmExpr -> FCode ()
    emitStore = AlignmentSpec -> CmmExpr -> CmmExpr -> FCode ()
    emitStore' AlignmentSpec
    NaturallyAligned

    emitStore' :: AlignmentSpec -> CmmExpr -> CmmExpr -> FCode ()
    emitStore' :: AlignmentSpec -> CmmExpr -> CmmExpr -> FCode ()
    emitStore' AlignmentSpec
    alignment CmmExpr
    l CmmExpr
    r = CgStmt -> FCode ()
    emitCgStmt (CmmNode O O -> CgStmt
    CgStmt (CmmExpr -> CmmExpr -> AlignmentSpec -> CmmNode O O
    CmmStore CmmExpr
    l CmmExpr
    r AlignmentSpec
    alignment))

    emit :: CmmAGraph -> FCode ()
    emit :: CmmAGraph -> FCode ()
    emit CmmAGraph
    ag
      = do  { CgState
    state <- FCode CgState
    getState
            ; CgState -> FCode ()
    setState forall a b. (a -> b) -> a -> b
    $ CgState
    state { cgs_stmts :: CmmAGraph
    cgs_stmts = CgState -> CmmAGraph
    cgs_stmts CgState
    state CmmAGraph -> CmmAGraph -> CmmAGraph
    CmmGraph.<*> CmmAGraph
    ag } }

    emitDecl :: CmmDecl -> FCode ()
    emitDecl :: CmmDecl -> FCode ()
    emitDecl CmmDecl
    decl
      = do  { CgState
    state <- FCode CgState
    getState
            ; CgState -> FCode ()
    setState forall a b. (a -> b) -> a -> b
    $ CgState
    state { cgs_tops :: OrdList CmmDecl
    cgs_tops = CgState -> OrdList CmmDecl
    cgs_tops CgState
    state forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmDecl
    decl } }

    emitOutOfLine :: BlockId -> CmmAGraphScoped -> FCode ()
    emitOutOfLine :: BlockId -> CmmAGraphScoped -> FCode ()
    emitOutOfLine BlockId
    l (CmmAGraph
    stmts, CmmTickScope
    tscope) = CgStmt -> FCode ()
    emitCgStmt (BlockId -> CmmAGraph -> CmmTickScope -> CgStmt
    CgFork BlockId
    l CmmAGraph
    stmts CmmTickScope
    tscope)

    emitProcWithStackFrame
       :: Convention                        -- entry convention
       -> Maybe CmmInfoTable                -- info table?
       -> CLabel                            -- label for the proc
       -> [CmmFormal]                       -- stack frame
       -> [CmmFormal]                       -- arguments
       -> CmmAGraphScoped                   -- code
       -> Bool                              -- do stack layout?
       -> FCode ()

    emitProcWithStackFrame :: Convention
    -> Maybe CmmInfoTable
    -> CLabel
    -> [LocalReg]
    -> [LocalReg]
    -> CmmAGraphScoped
    -> Bool
    -> FCode ()
    emitProcWithStackFrame Convention
    _conv Maybe CmmInfoTable
    mb_info CLabel
    lbl [LocalReg]
    _stk_args [] CmmAGraphScoped
    blocks Bool
    False
      = do  { Platform
    platform <- FCode Platform
    getPlatform
            ; Maybe CmmInfoTable
    -> CLabel
    -> [GlobalReg]
    -> CmmAGraphScoped
    -> VirtualHpOffset
    -> Bool
    -> FCode ()
    emitProc Maybe CmmInfoTable
    mb_info CLabel
    lbl [] CmmAGraphScoped
    blocks (Width -> VirtualHpOffset
    widthInBytes (Platform -> Width
    wordWidth Platform
    platform)) Bool
    False
            }
    emitProcWithStackFrame Convention
    conv Maybe CmmInfoTable
    mb_info CLabel
    lbl [LocalReg]
    stk_args [LocalReg]
    args (CmmAGraph
    graph, CmmTickScope
    tscope) Bool
    True
            -- do layout
      = do  { Profile
    profile <- FCode Profile
    getProfile
            ; let (VirtualHpOffset
    offset, [GlobalReg]
    live, CmmAGraph
    entry) = Profile
    -> Convention
    -> [LocalReg]
    -> [LocalReg]
    -> (VirtualHpOffset, [GlobalReg], CmmAGraph)
    mkCallEntry Profile
    profile Convention
    conv [LocalReg]
    args [LocalReg]
    stk_args
                  graph' :: CmmAGraph
    graph' = CmmAGraph
    entry CmmAGraph -> CmmAGraph -> CmmAGraph
    CmmGraph.<*> CmmAGraph
    graph
            ; Maybe CmmInfoTable
    -> CLabel
    -> [GlobalReg]
    -> CmmAGraphScoped
    -> VirtualHpOffset
    -> Bool
    -> FCode ()
    emitProc Maybe CmmInfoTable
    mb_info CLabel
    lbl [GlobalReg]
    live (CmmAGraph
    graph', CmmTickScope
    tscope) VirtualHpOffset
    offset Bool
    True
            }
    emitProcWithStackFrame Convention
    _ Maybe CmmInfoTable
    _ CLabel
    _ [LocalReg]
    _ [LocalReg]
    _ CmmAGraphScoped
    _ Bool
    _ = forall a. String -> a
    panic String
    "emitProcWithStackFrame"

    emitProcWithConvention :: Convention -> Maybe CmmInfoTable -> CLabel
                           -> [CmmFormal]
                           -> CmmAGraphScoped
                           -> FCode ()
    emitProcWithConvention :: Convention
    -> Maybe CmmInfoTable
    -> CLabel
    -> [LocalReg]
    -> CmmAGraphScoped
    -> FCode ()
    emitProcWithConvention Convention
    conv Maybe CmmInfoTable
    mb_info CLabel
    lbl [LocalReg]
    args CmmAGraphScoped
    blocks
      = Convention
    -> Maybe CmmInfoTable
    -> CLabel
    -> [LocalReg]
    -> [LocalReg]
    -> CmmAGraphScoped
    -> Bool
    -> FCode ()
    emitProcWithStackFrame Convention
    conv Maybe CmmInfoTable
    mb_info CLabel
    lbl [] [LocalReg]
    args CmmAGraphScoped
    blocks Bool
    True

    emitProc :: Maybe CmmInfoTable -> CLabel -> [GlobalReg] -> CmmAGraphScoped
             -> Int -> Bool -> FCode ()
    emitProc :: Maybe CmmInfoTable
    -> CLabel
    -> [GlobalReg]
    -> CmmAGraphScoped
    -> VirtualHpOffset
    -> Bool
    -> FCode ()
    emitProc Maybe CmmInfoTable
    mb_info CLabel
    lbl [GlobalReg]
    live CmmAGraphScoped
    blocks VirtualHpOffset
    offset Bool
    do_layout
      = do  { BlockId
    l <- forall (m :: * -> *). MonadUnique m => m BlockId
    newBlockId
            ; let
                  blks :: CmmGraph
                  blks :: CmmGraph
    blks = BlockId -> CmmAGraphScoped -> CmmGraph
    labelAGraph BlockId
    l CmmAGraphScoped
    blocks

                  infos :: LabelMap CmmInfoTable
    infos | Just CmmInfoTable
    info <- Maybe CmmInfoTable
    mb_info = forall (map :: * -> *) a. IsMap map => KeyOf map -> a -> map a
    mapSingleton (forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> BlockId
    g_entry CmmGraph
    blks) CmmInfoTable
    info
                        | Bool
    otherwise            = forall (map :: * -> *) a. IsMap map => map a
    mapEmpty

                  sinfo :: CmmStackInfo
    sinfo = StackInfo { arg_space :: VirtualHpOffset
    arg_space = VirtualHpOffset
    offset
                                    , do_layout :: Bool
    do_layout = Bool
    do_layout }

                  tinfo :: CmmTopInfo
    tinfo = TopInfo { info_tbls :: LabelMap CmmInfoTable
    info_tbls = LabelMap CmmInfoTable
    infos
                                  , stack_info :: CmmStackInfo
    stack_info=CmmStackInfo
    sinfo}

                  proc_block :: CmmDecl
    proc_block = forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc CmmTopInfo
    tinfo CLabel
    lbl [GlobalReg]
    live CmmGraph
    blks

            ; CgState
    state <- FCode CgState
    getState
            ; CgState -> FCode ()
    setState forall a b. (a -> b) -> a -> b
    $ CgState
    state { cgs_tops :: OrdList CmmDecl
    cgs_tops = CgState -> OrdList CmmDecl
    cgs_tops CgState
    state forall a. OrdList a -> a -> OrdList a
    `snocOL` CmmDecl
    proc_block } }

    getCmm :: FCode a -> FCode (a, CmmGroup)
    -- Get all the CmmTops (there should be no stmts)
    -- Return a single Cmm which may be split from other Cmms by
    -- object splitting (at a later stage)
    getCmm :: forall a. FCode a -> FCode (a, CmmGroup)
    getCmm FCode a
    code
      = do  { CgState
    state1 <- FCode CgState
    getState
            ; (a
    a, CgState
    state2) <- forall a. FCode a -> CgState -> FCode (a, CgState)
    withState FCode a
    code (CgState
    state1 { cgs_tops :: OrdList CmmDecl
    cgs_tops  = forall a. OrdList a
    nilOL })
            ; CgState -> FCode ()
    setState forall a b. (a -> b) -> a -> b
    $ CgState
    state2 { cgs_tops :: OrdList CmmDecl
    cgs_tops = CgState -> OrdList CmmDecl
    cgs_tops CgState
    state1 }
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    a, forall a. OrdList a -> [a]
    fromOL (CgState -> OrdList CmmDecl
    cgs_tops CgState
    state2)) }

    mkCmmIfThenElse :: CmmExpr -> CmmAGraph -> CmmAGraph -> FCode CmmAGraph
    mkCmmIfThenElse :: CmmExpr -> CmmAGraph -> CmmAGraph -> FCode CmmAGraph
    mkCmmIfThenElse CmmExpr
    e CmmAGraph
    tbranch CmmAGraph
    fbranch = CmmExpr -> CmmAGraph -> CmmAGraph -> Maybe Bool -> FCode CmmAGraph
    mkCmmIfThenElse' CmmExpr
    e CmmAGraph
    tbranch CmmAGraph
    fbranch forall a. Maybe a
    Nothing

    mkCmmIfThenElse' :: CmmExpr -> CmmAGraph -> CmmAGraph
                     -> Maybe Bool -> FCode CmmAGraph
    mkCmmIfThenElse' :: CmmExpr -> CmmAGraph -> CmmAGraph -> Maybe Bool -> FCode CmmAGraph
    mkCmmIfThenElse' CmmExpr
    e CmmAGraph
    tbranch CmmAGraph
    fbranch Maybe Bool
    likely = do
      CmmTickScope
    tscp  <- FCode CmmTickScope
    getTickScope
      BlockId
    endif <- forall (m :: * -> *). MonadUnique m => m BlockId
    newBlockId
      BlockId
    tid   <- forall (m :: * -> *). MonadUnique m => m BlockId
    newBlockId
      BlockId
    fid   <- forall (m :: * -> *). MonadUnique m => m BlockId
    newBlockId

      let
        (CmmExpr
    test, CmmAGraph
    then_, CmmAGraph
    else_, Maybe Bool
    likely') = case Maybe Bool
    likely of
          Just Bool
    False | Just CmmExpr
    e' <- CmmExpr -> Maybe CmmExpr
    maybeInvertCmmExpr CmmExpr
    e
            -- currently NCG doesn't know about likely
            -- annotations. We manually switch then and
            -- else branch so the likely false branch
            -- becomes a fallthrough.
            -> (CmmExpr
    e', CmmAGraph
    fbranch, CmmAGraph
    tbranch, forall a. a -> Maybe a
    Just Bool
    True)
          Maybe Bool
    _ -> (CmmExpr
    e, CmmAGraph
    tbranch, CmmAGraph
    fbranch, Maybe Bool
    likely)

      forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ [CmmAGraph] -> CmmAGraph
    catAGraphs [ CmmExpr -> BlockId -> BlockId -> Maybe Bool -> CmmAGraph
    mkCbranch CmmExpr
    test BlockId
    tid BlockId
    fid Maybe Bool
    likely'
                          , BlockId -> CmmTickScope -> CmmAGraph
    mkLabel BlockId
    tid CmmTickScope
    tscp, CmmAGraph
    then_, BlockId -> CmmAGraph
    mkBranch BlockId
    endif
                          , BlockId -> CmmTickScope -> CmmAGraph
    mkLabel BlockId
    fid CmmTickScope
    tscp, CmmAGraph
    else_, BlockId -> CmmTickScope -> CmmAGraph
    mkLabel BlockId
    endif CmmTickScope
    tscp ]

    mkCmmIfGoto :: CmmExpr -> BlockId -> FCode CmmAGraph
    mkCmmIfGoto :: CmmExpr -> BlockId -> FCode CmmAGraph
    mkCmmIfGoto CmmExpr
    e BlockId
    tid = CmmExpr -> BlockId -> Maybe Bool -> FCode CmmAGraph
    mkCmmIfGoto' CmmExpr
    e BlockId
    tid forall a. Maybe a
    Nothing

    mkCmmIfGoto' :: CmmExpr -> BlockId -> Maybe Bool -> FCode CmmAGraph
    mkCmmIfGoto' :: CmmExpr -> BlockId -> Maybe Bool -> FCode CmmAGraph
    mkCmmIfGoto' CmmExpr
    e BlockId
    tid Maybe Bool
    l = do
      BlockId
    endif <- forall (m :: * -> *). MonadUnique m => m BlockId
    newBlockId
      CmmTickScope
    tscp  <- FCode CmmTickScope
    getTickScope
      forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ [CmmAGraph] -> CmmAGraph
    catAGraphs [ CmmExpr -> BlockId -> BlockId -> Maybe Bool -> CmmAGraph
    mkCbranch CmmExpr
    e BlockId
    tid BlockId
    endif Maybe Bool
    l, BlockId -> CmmTickScope -> CmmAGraph
    mkLabel BlockId
    endif CmmTickScope
    tscp ]

    mkCmmIfThen :: CmmExpr -> CmmAGraph -> FCode CmmAGraph
    mkCmmIfThen :: CmmExpr -> CmmAGraph -> FCode CmmAGraph
    mkCmmIfThen CmmExpr
    e CmmAGraph
    tbranch = CmmExpr -> CmmAGraph -> Maybe Bool -> FCode CmmAGraph
    mkCmmIfThen' CmmExpr
    e CmmAGraph
    tbranch forall a. Maybe a
    Nothing

    mkCmmIfThen' :: CmmExpr -> CmmAGraph -> Maybe Bool -> FCode CmmAGraph
    mkCmmIfThen' :: CmmExpr -> CmmAGraph -> Maybe Bool -> FCode CmmAGraph
    mkCmmIfThen' CmmExpr
    e CmmAGraph
    tbranch Maybe Bool
    l = do
      BlockId
    endif <- forall (m :: * -> *). MonadUnique m => m BlockId
    newBlockId
      BlockId
    tid   <- forall (m :: * -> *). MonadUnique m => m BlockId
    newBlockId
      CmmTickScope
    tscp  <- FCode CmmTickScope
    getTickScope
      forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ [CmmAGraph] -> CmmAGraph
    catAGraphs [ CmmExpr -> BlockId -> BlockId -> Maybe Bool -> CmmAGraph
    mkCbranch CmmExpr
    e BlockId
    tid BlockId
    endif Maybe Bool
    l
                          , BlockId -> CmmTickScope -> CmmAGraph
    mkLabel BlockId
    tid CmmTickScope
    tscp, CmmAGraph
    tbranch, BlockId -> CmmTickScope -> CmmAGraph
    mkLabel BlockId
    endif CmmTickScope
    tscp ]

    mkCall :: CmmExpr -> (Convention, Convention) -> [CmmFormal] -> [CmmExpr]
           -> UpdFrameOffset -> [CmmExpr] -> FCode CmmAGraph
    mkCall :: CmmExpr
    -> (Convention, Convention)
    -> [LocalReg]
    -> [CmmExpr]
    -> VirtualHpOffset
    -> [CmmExpr]
    -> FCode CmmAGraph
    mkCall CmmExpr
    f (Convention
    callConv, Convention
    retConv) [LocalReg]
    results [CmmExpr]
    actuals VirtualHpOffset
    updfr_off [CmmExpr]
    extra_stack = do
      Profile
    profile <- FCode Profile
    getProfile
      BlockId
    k       <- forall (m :: * -> *). MonadUnique m => m BlockId
    newBlockId
      CmmTickScope
    tscp    <- FCode CmmTickScope
    getTickScope
      let area :: Area
    area = BlockId -> Area
    Young BlockId
    k
          (VirtualHpOffset
    off, [GlobalReg]
    _, CmmAGraph
    copyin) = Profile
    -> Convention
    -> Area
    -> [LocalReg]
    -> [LocalReg]
    -> (VirtualHpOffset, [GlobalReg], CmmAGraph)
    copyInOflow Profile
    profile Convention
    retConv Area
    area [LocalReg]
    results []
          copyout :: CmmAGraph
    copyout = Profile
    -> CmmExpr
    -> Convention
    -> [CmmExpr]
    -> BlockId
    -> VirtualHpOffset
    -> VirtualHpOffset
    -> [CmmExpr]
    -> CmmAGraph
    mkCallReturnsTo Profile
    profile CmmExpr
    f Convention
    callConv [CmmExpr]
    actuals BlockId
    k VirtualHpOffset
    off VirtualHpOffset
    updfr_off [CmmExpr]
    extra_stack
      forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ [CmmAGraph] -> CmmAGraph
    catAGraphs [CmmAGraph
    copyout, BlockId -> CmmTickScope -> CmmAGraph
    mkLabel BlockId
    k CmmTickScope
    tscp, CmmAGraph
    copyin]

    mkCmmCall :: CmmExpr -> [CmmFormal] -> [CmmExpr] -> UpdFrameOffset
              -> FCode CmmAGraph
    mkCmmCall :: CmmExpr
    -> [LocalReg] -> [CmmExpr] -> VirtualHpOffset -> FCode CmmAGraph
    mkCmmCall CmmExpr
    f [LocalReg]
    results [CmmExpr]
    actuals VirtualHpOffset
    updfr_off
       = CmmExpr
    -> (Convention, Convention)
    -> [LocalReg]
    -> [CmmExpr]
    -> VirtualHpOffset
    -> [CmmExpr]
    -> FCode CmmAGraph
    mkCall CmmExpr
    f (Convention
    NativeDirectCall, Convention
    NativeReturn) [LocalReg]
    results [CmmExpr]
    actuals VirtualHpOffset
    updfr_off []

    -- ----------------------------------------------------------------------------
    -- turn CmmAGraph into CmmGraph, for making a new proc.

    aGraphToGraph :: CmmAGraphScoped -> FCode CmmGraph
    aGraphToGraph :: CmmAGraphScoped -> FCode CmmGraph
    aGraphToGraph CmmAGraphScoped
    stmts
      = do  { BlockId
    l <- forall (m :: * -> *). MonadUnique m => m BlockId
    newBlockId
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (BlockId -> CmmAGraphScoped -> CmmGraph
    labelAGraph BlockId
    l CmmAGraphScoped
    stmts) }