    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveFunctor #-}
    {-# LANGUAGE BangPatterns #-}

    -- -----------------------------------------------------------------------------
    --
    -- (c) The University of Glasgow 1993-2004
    --
    -- The native code generator's monad.
    --
    -- -----------------------------------------------------------------------------

    module GHC.CmmToAsm.Monad (
            NcgImpl(..),
            NatM_State(..), mkNatM_State,

            NatM, -- instance Monad
            initNat,
            addImportNat,
            addNodeBetweenNat,
            addImmediateSuccessorNat,
            updateCfgNat,
            getUniqueNat,
            mapAccumLNat,
            setDeltaNat,
            getConfig,
            getPlatform,
            getDeltaNat,
            getThisModuleNat,
            getBlockIdNat,
            getNewLabelNat,
            getNewRegNat,
            getNewRegPairNat,
            getPicBaseMaybeNat,
            getPicBaseNat,
            getCfgWeights,
            getModLoc,
            getFileId,
            getDebugBlock,

            DwarfFiles
    )

    where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Platform
    import GHC.Platform.Reg
    import GHC.CmmToAsm.Format
    import GHC.CmmToAsm.Reg.Target
    import GHC.CmmToAsm.Config
    import GHC.CmmToAsm.Types

    import GHC.Cmm.BlockId
    import GHC.Cmm.Dataflow.Collections
    import GHC.Cmm.Dataflow.Label
    import GHC.Cmm.CLabel           ( CLabel )
    import GHC.Cmm.DebugBlock
    import GHC.Data.FastString      ( FastString )
    import GHC.Types.Unique.FM
    import GHC.Types.Unique.Supply
    import GHC.Types.Unique         ( Unique )
    import GHC.Unit.Module

    import Control.Monad    ( ap )

    import GHC.Utils.Outputable (SDoc, ppr)
    import GHC.Utils.Panic      (pprPanic)
    import GHC.CmmToAsm.CFG
    import GHC.CmmToAsm.CFG.Weight

    data NcgImpl statics instr jumpDest = NcgImpl {
        forall statics instr jumpDest.
    NcgImpl statics instr jumpDest -> NCGConfig
    ncgConfig                 :: !NCGConfig,
        forall statics instr jumpDest.
    NcgImpl statics instr jumpDest
    -> RawCmmDecl -> NatM [NatCmmDecl statics instr]
    cmmTopCodeGen             :: RawCmmDecl -> NatM [NatCmmDecl statics instr],
        forall statics instr jumpDest.
    NcgImpl statics instr jumpDest
    -> instr -> Maybe (NatCmmDecl statics instr)
    generateJumpTableForInstr :: instr -> Maybe (NatCmmDecl statics instr),
        forall statics instr jumpDest.
    NcgImpl statics instr jumpDest -> jumpDest -> Maybe BlockId
    getJumpDestBlockId        :: jumpDest -> Maybe BlockId,
        forall statics instr jumpDest.
    NcgImpl statics instr jumpDest -> instr -> Maybe jumpDest
    canShortcut               :: instr -> Maybe jumpDest,
        forall statics instr jumpDest.
    NcgImpl statics instr jumpDest
    -> (BlockId -> Maybe jumpDest) -> statics -> statics
    shortcutStatics           :: (BlockId -> Maybe jumpDest) -> statics -> statics,
        forall statics instr jumpDest.
    NcgImpl statics instr jumpDest
    -> (BlockId -> Maybe jumpDest) -> instr -> instr
    shortcutJump              :: (BlockId -> Maybe jumpDest) -> instr -> instr,
        -- | 'Module' is only for printing internal labels. See Note [Internal proc
        -- labels] in CLabel.
        forall statics instr jumpDest.
    NcgImpl statics instr jumpDest -> NatCmmDecl statics instr -> SDoc
    pprNatCmmDecl             :: NatCmmDecl statics instr -> SDoc,
        forall statics instr jumpDest.
    NcgImpl statics instr jumpDest -> Int
    maxSpillSlots             :: Int,
        forall statics instr jumpDest.
    NcgImpl statics instr jumpDest -> [RealReg]
    allocatableRegs           :: [RealReg],
        forall statics instr jumpDest.
    NcgImpl statics instr jumpDest
    -> [NatCmmDecl statics instr] -> [NatCmmDecl statics instr]
    ncgExpandTop              :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],
        forall statics instr jumpDest.
    NcgImpl statics instr jumpDest
    -> Int
    -> NatCmmDecl statics instr
    -> UniqSM (NatCmmDecl statics instr, [(BlockId, BlockId)])
    ncgAllocMoreStack         :: Int -> NatCmmDecl statics instr
                                  -> UniqSM (NatCmmDecl statics instr, [(BlockId,BlockId)]),
        -- ^ The list of block ids records the redirected jumps to allow us to update
        -- the CFG.
        forall statics instr jumpDest.
    NcgImpl statics instr jumpDest
    -> LabelMap RawCmmStatics
    -> [NatBasicBlock instr]
    -> [NatBasicBlock instr]
    ncgMakeFarBranches        :: LabelMap RawCmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr],
        forall statics instr jumpDest.
    NcgImpl statics instr jumpDest -> [instr] -> [UnwindPoint]
    extractUnwindPoints       :: [instr] -> [UnwindPoint],
        -- ^ given the instruction sequence of a block, produce a list of
        -- the block's 'UnwindPoint's
        -- See Note [What is this unwinding business?] in "GHC.Cmm.DebugBlock"
        -- and Note [Unwinding information in the NCG] in this module.
        forall statics instr jumpDest.
    NcgImpl statics instr jumpDest
    -> Maybe CFG
    -> LabelMap RawCmmStatics
    -> [NatBasicBlock instr]
    -> [NatBasicBlock instr]
    invertCondBranches        :: Maybe CFG -> LabelMap RawCmmStatics -> [NatBasicBlock instr]
                                  -> [NatBasicBlock instr]
        -- ^ Turn the sequence of @jcc l1; jmp l2@ into @jncc l2; \<block_l1>@
        -- when possible.
        }

    data NatM_State
            = NatM_State {
                    NatM_State -> UniqSupply
    natm_us          :: UniqSupply,
                    NatM_State -> Int
    natm_delta       :: Int,
                    NatM_State -> [CLabel]
    natm_imports     :: [(CLabel)],
                    NatM_State -> Maybe Reg
    natm_pic         :: Maybe Reg,
                    NatM_State -> NCGConfig
    natm_config      :: NCGConfig,
                    NatM_State -> ModLocation
    natm_modloc      :: ModLocation,
                    NatM_State -> DwarfFiles
    natm_fileid      :: DwarfFiles,
                    NatM_State -> LabelMap DebugBlock
    natm_debug_map   :: LabelMap DebugBlock,
                    NatM_State -> CFG
    natm_cfg         :: CFG
            -- ^ Having a CFG with additional information is essential for some
            -- operations. However we can't reconstruct all information once we
            -- generated instructions. So instead we update the CFG as we go.
            }

    type DwarfFiles = UniqFM FastString (FastString, Int)

    newtype NatM result = NatM (NatM_State -> (result, NatM_State))
        deriving ((forall a b. (a -> b) -> NatM a -> NatM b)
    -> (forall a b. a -> NatM b -> NatM a) -> Functor NatM
    forall a b. a -> NatM b -> NatM a
    forall a b. (a -> b) -> NatM a -> NatM b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    <$ :: forall a b. a -> NatM b -> NatM a
    $c<$ :: forall a b. a -> NatM b -> NatM a
    fmap :: forall a b. (a -> b) -> NatM a -> NatM b
    $cfmap :: forall a b. (a -> b) -> NatM a -> NatM b
    Functor)

    unNat :: NatM a -> NatM_State -> (a, NatM_State)
    unNat :: forall a. NatM a -> NatM_State -> (a, NatM_State)
    unNat (NatM NatM_State -> (a, NatM_State)
    a) = NatM_State -> (a, NatM_State)
    a

    mkNatM_State :: UniqSupply -> Int -> NCGConfig -> ModLocation ->
                    DwarfFiles -> LabelMap DebugBlock -> CFG -> NatM_State
    mkNatM_State :: UniqSupply
    -> Int
    -> NCGConfig
    -> ModLocation
    -> DwarfFiles
    -> LabelMap DebugBlock
    -> CFG
    -> NatM_State
    mkNatM_State UniqSupply
    us Int
    delta NCGConfig
    config
            = \ModLocation
    loc DwarfFiles
    dwf LabelMap DebugBlock
    dbg CFG
    cfg ->
                    NatM_State
                            { natm_us :: UniqSupply
    natm_us = UniqSupply
    us
                            , natm_delta :: Int
    natm_delta = Int
    delta
                            , natm_imports :: [CLabel]
    natm_imports = []
                            , natm_pic :: Maybe Reg
    natm_pic = Maybe Reg
    forall a. Maybe a
    Nothing
                            , natm_config :: NCGConfig
    natm_config = NCGConfig
    config
                            , natm_modloc :: ModLocation
    natm_modloc = ModLocation
    loc
                            , natm_fileid :: DwarfFiles
    natm_fileid = DwarfFiles
    dwf
                            , natm_debug_map :: LabelMap DebugBlock
    natm_debug_map = LabelMap DebugBlock
    dbg
                            , natm_cfg :: CFG
    natm_cfg = CFG
    cfg
                            }

    initNat :: NatM_State -> NatM a -> (a, NatM_State)
    initNat :: forall a. NatM_State -> NatM a -> (a, NatM_State)
    initNat NatM_State
    init_st NatM a
    m
            = case NatM a -> NatM_State -> (a, NatM_State)
    forall a. NatM a -> NatM_State -> (a, NatM_State)
    unNat NatM a
    m NatM_State
    init_st of { (a
    r,NatM_State
    st) -> (a
    r,NatM_State
    st) }

    instance Applicative NatM where
          pure :: forall a. a -> NatM a
    pure = a -> NatM a
    forall a. a -> NatM a
    returnNat
          <*> :: forall a b. NatM (a -> b) -> NatM a -> NatM b
    (<*>) = NatM (a -> b) -> NatM a -> NatM b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    instance Monad NatM where
      >>= :: forall a b. NatM a -> (a -> NatM b) -> NatM b
    (>>=) = NatM a -> (a -> NatM b) -> NatM b
    forall a b. NatM a -> (a -> NatM b) -> NatM b
    thenNat

    instance MonadUnique NatM where
      getUniqueSupplyM :: NatM UniqSupply
    getUniqueSupplyM = (NatM_State -> (UniqSupply, NatM_State)) -> NatM UniqSupply
    forall result. (NatM_State -> (result, NatM_State)) -> NatM result
    NatM ((NatM_State -> (UniqSupply, NatM_State)) -> NatM UniqSupply)
    -> (NatM_State -> (UniqSupply, NatM_State)) -> NatM UniqSupply
    forall a b. (a -> b) -> a -> b
    $ \NatM_State
    st ->
          case UniqSupply -> (UniqSupply, UniqSupply)
    splitUniqSupply (NatM_State -> UniqSupply
    natm_us NatM_State
    st) of
              (UniqSupply
    us1, UniqSupply
    us2) -> (UniqSupply
    us1, NatM_State
    st {natm_us :: UniqSupply
    natm_us = UniqSupply
    us2})

      getUniqueM :: NatM Unique
    getUniqueM = (NatM_State -> (Unique, NatM_State)) -> NatM Unique
    forall result. (NatM_State -> (result, NatM_State)) -> NatM result
    NatM ((NatM_State -> (Unique, NatM_State)) -> NatM Unique)
    -> (NatM_State -> (Unique, NatM_State)) -> NatM Unique
    forall a b. (a -> b) -> a -> b
    $ \NatM_State
    st ->
          case UniqSupply -> (Unique, UniqSupply)
    takeUniqFromSupply (NatM_State -> UniqSupply
    natm_us NatM_State
    st) of
              (Unique
    uniq, UniqSupply
    us') -> (Unique
    uniq, NatM_State
    st {natm_us :: UniqSupply
    natm_us = UniqSupply
    us'})

    thenNat :: NatM a -> (a -> NatM b) -> NatM b
    thenNat :: forall a b. NatM a -> (a -> NatM b) -> NatM b
    thenNat NatM a
    expr a -> NatM b
    cont
            = (NatM_State -> (b, NatM_State)) -> NatM b
    forall result. (NatM_State -> (result, NatM_State)) -> NatM result
    NatM ((NatM_State -> (b, NatM_State)) -> NatM b)
    -> (NatM_State -> (b, NatM_State)) -> NatM b
    forall a b. (a -> b) -> a -> b
    $ \NatM_State
    st -> case NatM a -> NatM_State -> (a, NatM_State)
    forall a. NatM a -> NatM_State -> (a, NatM_State)
    unNat NatM a
    expr NatM_State
    st of
                            (a
    result, NatM_State
    st') -> NatM b -> NatM_State -> (b, NatM_State)
    forall a. NatM a -> NatM_State -> (a, NatM_State)
    unNat (a -> NatM b
    cont a
    result) NatM_State
    st'

    returnNat :: a -> NatM a
    returnNat :: forall a. a -> NatM a
    returnNat a
    result
            = (NatM_State -> (a, NatM_State)) -> NatM a
    forall result. (NatM_State -> (result, NatM_State)) -> NatM result
    NatM ((NatM_State -> (a, NatM_State)) -> NatM a)
    -> (NatM_State -> (a, NatM_State)) -> NatM a
    forall a b. (a -> b) -> a -> b
    $ \NatM_State
    st ->  (a
    result, NatM_State
    st)

    mapAccumLNat :: (acc -> x -> NatM (acc, y))
                    -> acc
                    -> [x]
                    -> NatM (acc, [y])

    mapAccumLNat :: forall acc x y.
    (acc -> x -> NatM (acc, y)) -> acc -> [x] -> NatM (acc, [y])
    mapAccumLNat acc -> x -> NatM (acc, y)
    _ acc
    b []
      = (acc, [y]) -> NatM (acc, [y])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (acc
    b, [])
    mapAccumLNat acc -> x -> NatM (acc, y)
    f acc
    b (x
    x:[x]
    xs)
      = do (acc
    b__2, y
    x__2)  <- acc -> x -> NatM (acc, y)
    f acc
    b x
    x
           (acc
    b__3, [y]
    xs__2) <- (acc -> x -> NatM (acc, y)) -> acc -> [x] -> NatM (acc, [y])
    forall acc x y.
    (acc -> x -> NatM (acc, y)) -> acc -> [x] -> NatM (acc, [y])
    mapAccumLNat acc -> x -> NatM (acc, y)
    f acc
    b__2 [x]
    xs
           (acc, [y]) -> NatM (acc, [y])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (acc
    b__3, y
    x__2y -> [y] -> [y]
    forall a. a -> [a] -> [a]
    :[y]
    xs__2)

    getUniqueNat :: NatM Unique
    getUniqueNat :: NatM Unique
    getUniqueNat = (NatM_State -> (Unique, NatM_State)) -> NatM Unique
    forall result. (NatM_State -> (result, NatM_State)) -> NatM result
    NatM ((NatM_State -> (Unique, NatM_State)) -> NatM Unique)
    -> (NatM_State -> (Unique, NatM_State)) -> NatM Unique
    forall a b. (a -> b) -> a -> b
    $ \ NatM_State
    st ->
        case UniqSupply -> (Unique, UniqSupply)
    takeUniqFromSupply (UniqSupply -> (Unique, UniqSupply))
    -> UniqSupply -> (Unique, UniqSupply)
    forall a b. (a -> b) -> a -> b
    $ NatM_State -> UniqSupply
    natm_us NatM_State
    st of
        (Unique
    uniq, UniqSupply
    us') -> (Unique
    uniq, NatM_State
    st {natm_us :: UniqSupply
    natm_us = UniqSupply
    us'})

    getDeltaNat :: NatM Int
    getDeltaNat :: NatM Int
    getDeltaNat = (NatM_State -> (Int, NatM_State)) -> NatM Int
    forall result. (NatM_State -> (result, NatM_State)) -> NatM result
    NatM ((NatM_State -> (Int, NatM_State)) -> NatM Int)
    -> (NatM_State -> (Int, NatM_State)) -> NatM Int
    forall a b. (a -> b) -> a -> b
    $ \ NatM_State
    st -> (NatM_State -> Int
    natm_delta NatM_State
    st, NatM_State
    st)

    -- | Get CFG edge weights
    getCfgWeights :: NatM Weights
    getCfgWeights :: NatM Weights
    getCfgWeights = (NatM_State -> (Weights, NatM_State)) -> NatM Weights
    forall result. (NatM_State -> (result, NatM_State)) -> NatM result
    NatM ((NatM_State -> (Weights, NatM_State)) -> NatM Weights)
    -> (NatM_State -> (Weights, NatM_State)) -> NatM Weights
    forall a b. (a -> b) -> a -> b
    $ \ NatM_State
    st -> (NCGConfig -> Weights
    ncgCfgWeights (NatM_State -> NCGConfig
    natm_config NatM_State
    st), NatM_State
    st)

    setDeltaNat :: Int -> NatM ()
    setDeltaNat :: Int -> NatM ()
    setDeltaNat Int
    delta = (NatM_State -> ((), NatM_State)) -> NatM ()
    forall result. (NatM_State -> (result, NatM_State)) -> NatM result
    NatM ((NatM_State -> ((), NatM_State)) -> NatM ())
    -> (NatM_State -> ((), NatM_State)) -> NatM ()
    forall a b. (a -> b) -> a -> b
    $ \ NatM_State
    st -> ((), NatM_State
    st {natm_delta :: Int
    natm_delta = Int
    delta})

    getThisModuleNat :: NatM Module
    getThisModuleNat :: NatM Module
    getThisModuleNat = (NatM_State -> (Module, NatM_State)) -> NatM Module
    forall result. (NatM_State -> (result, NatM_State)) -> NatM result
    NatM ((NatM_State -> (Module, NatM_State)) -> NatM Module)
    -> (NatM_State -> (Module, NatM_State)) -> NatM Module
    forall a b. (a -> b) -> a -> b
    $ \ NatM_State
    st -> (NCGConfig -> Module
    ncgThisModule (NCGConfig -> Module) -> NCGConfig -> Module
    forall a b. (a -> b) -> a -> b
    $ NatM_State -> NCGConfig
    natm_config NatM_State
    st, NatM_State
    st)

    instance HasModule NatM where
      getModule :: NatM Module
    getModule = NatM Module
    getThisModuleNat

    addImportNat :: CLabel -> NatM ()
    addImportNat :: CLabel -> NatM ()
    addImportNat CLabel
    imp
            = (NatM_State -> ((), NatM_State)) -> NatM ()
    forall result. (NatM_State -> (result, NatM_State)) -> NatM result
    NatM ((NatM_State -> ((), NatM_State)) -> NatM ())
    -> (NatM_State -> ((), NatM_State)) -> NatM ()
    forall a b. (a -> b) -> a -> b
    $ \ NatM_State
    st -> ((), NatM_State
    st {natm_imports :: [CLabel]
    natm_imports = CLabel
    imp CLabel -> [CLabel] -> [CLabel]
    forall a. a -> [a] -> [a]
    : NatM_State -> [CLabel]
    natm_imports NatM_State
    st})

    updateCfgNat :: (CFG -> CFG) -> NatM ()
    updateCfgNat :: (CFG -> CFG) -> NatM ()
    updateCfgNat CFG -> CFG
    f
            = (NatM_State -> ((), NatM_State)) -> NatM ()
    forall result. (NatM_State -> (result, NatM_State)) -> NatM result
    NatM ((NatM_State -> ((), NatM_State)) -> NatM ())
    -> (NatM_State -> ((), NatM_State)) -> NatM ()
    forall a b. (a -> b) -> a -> b
    $ \ NatM_State
    st -> let !cfg' :: CFG
    cfg' = CFG -> CFG
    f (NatM_State -> CFG
    natm_cfg NatM_State
    st)
                             in ((), NatM_State
    st { natm_cfg :: CFG
    natm_cfg = CFG
    cfg'})

    -- | Record that we added a block between `from` and `old`.
    addNodeBetweenNat :: BlockId -> BlockId -> BlockId -> NatM ()
    addNodeBetweenNat :: BlockId -> BlockId -> BlockId -> NatM ()
    addNodeBetweenNat BlockId
    from BlockId
    between BlockId
    to
     = do   Weights
    weights <- NatM Weights
    getCfgWeights
            let jmpWeight :: EdgeWeight
    jmpWeight = Int -> EdgeWeight
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Weights -> Int
    uncondWeight Weights
    weights)
            (CFG -> CFG) -> NatM ()
    updateCfgNat (EdgeWeight -> BlockId -> BlockId -> BlockId -> CFG -> CFG
    updateCfg EdgeWeight
    jmpWeight BlockId
    from BlockId
    between BlockId
    to)
      where
        -- When transforming A -> B to A -> A' -> B
        -- A -> A' keeps the old edge info while
        -- A' -> B gets the info for an unconditional
        -- jump.
        updateCfg :: EdgeWeight -> BlockId -> BlockId -> BlockId -> CFG -> CFG
    updateCfg EdgeWeight
    weight BlockId
    from BlockId
    between BlockId
    old CFG
    m
            | Just EdgeInfo
    info <- BlockId -> BlockId -> CFG -> Maybe EdgeInfo
    getEdgeInfo BlockId
    from BlockId
    old CFG
    m
            = BlockId -> BlockId -> EdgeInfo -> CFG -> CFG
    addEdge BlockId
    from BlockId
    between EdgeInfo
    info (CFG -> CFG) -> (CFG -> CFG) -> CFG -> CFG
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
              BlockId -> BlockId -> EdgeWeight -> CFG -> CFG
    addWeightEdge BlockId
    between BlockId
    old EdgeWeight
    weight (CFG -> CFG) -> (CFG -> CFG) -> CFG -> CFG
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
              BlockId -> BlockId -> CFG -> CFG
    delEdge BlockId
    from BlockId
    old (CFG -> CFG) -> CFG -> CFG
    forall a b. (a -> b) -> a -> b
    $ CFG
    m
            | Bool
    otherwise
            = String -> SDoc -> CFG
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "Failed to update cfg: Untracked edge" ((BlockId, BlockId) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (BlockId
    from,BlockId
    to))

    -- | Place `succ` after `block` and change any edges
    --   block -> X to `succ` -> X
    addImmediateSuccessorNat :: BlockId -> BlockId -> NatM ()
    addImmediateSuccessorNat :: BlockId -> BlockId -> NatM ()
    addImmediateSuccessorNat BlockId
    block BlockId
    succ = do
       Weights
    weights <- NatM Weights
    getCfgWeights
       (CFG -> CFG) -> NatM ()
    updateCfgNat (Weights -> BlockId -> BlockId -> CFG -> CFG
    addImmediateSuccessor Weights
    weights BlockId
    block BlockId
    succ)

    getBlockIdNat :: NatM BlockId
    getBlockIdNat :: NatM BlockId
    getBlockIdNat
     = do   Unique
    u <- NatM Unique
    getUniqueNat
            BlockId -> NatM BlockId
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Unique -> BlockId
    mkBlockId Unique
    u)

    getNewLabelNat :: NatM CLabel
    getNewLabelNat :: NatM CLabel
    getNewLabelNat
     = BlockId -> CLabel
    blockLbl (BlockId -> CLabel) -> NatM BlockId -> NatM CLabel
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NatM BlockId
    getBlockIdNat

    getNewRegNat :: Format -> NatM Reg
    getNewRegNat :: Format -> NatM Reg
    getNewRegNat Format
    rep
     = do Unique
    u <- NatM Unique
    getUniqueNat
          Platform
    platform <- NatM Platform
    getPlatform
          Reg -> NatM Reg
    forall (m :: * -> *) a. Monad m => a -> m a
    return (VirtualReg -> Reg
    RegVirtual (VirtualReg -> Reg) -> VirtualReg -> Reg
    forall a b. (a -> b) -> a -> b
    $ Platform -> Unique -> Format -> VirtualReg
    targetMkVirtualReg Platform
    platform Unique
    u Format
    rep)

    getNewRegPairNat :: Format -> NatM (Reg,Reg)
    getNewRegPairNat :: Format -> NatM (Reg, Reg)
    getNewRegPairNat Format
    rep
     = do Unique
    u <- NatM Unique
    getUniqueNat
          Platform
    platform <- NatM Platform
    getPlatform
          let vLo :: VirtualReg
    vLo = Platform -> Unique -> Format -> VirtualReg
    targetMkVirtualReg Platform
    platform Unique
    u Format
    rep
          let lo :: Reg
    lo  = VirtualReg -> Reg
    RegVirtual (VirtualReg -> Reg) -> VirtualReg -> Reg
    forall a b. (a -> b) -> a -> b
    $ Platform -> Unique -> Format -> VirtualReg
    targetMkVirtualReg Platform
    platform Unique
    u Format
    rep
          let hi :: Reg
    hi  = VirtualReg -> Reg
    RegVirtual (VirtualReg -> Reg) -> VirtualReg -> Reg
    forall a b. (a -> b) -> a -> b
    $ VirtualReg -> VirtualReg
    getHiVirtualRegFromLo VirtualReg
    vLo
          (Reg, Reg) -> NatM (Reg, Reg)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Reg
    lo, Reg
    hi)

    getPicBaseMaybeNat :: NatM (Maybe Reg)
    getPicBaseMaybeNat :: NatM (Maybe Reg)
    getPicBaseMaybeNat
            = (NatM_State -> (Maybe Reg, NatM_State)) -> NatM (Maybe Reg)
    forall result. (NatM_State -> (result, NatM_State)) -> NatM result
    NatM (\NatM_State
    state -> (NatM_State -> Maybe Reg
    natm_pic NatM_State
    state, NatM_State
    state))

    getPicBaseNat :: Format -> NatM Reg
    getPicBaseNat :: Format -> NatM Reg
    getPicBaseNat Format
    rep
     = do   Maybe Reg
    mbPicBase <- NatM (Maybe Reg)
    getPicBaseMaybeNat
            case Maybe Reg
    mbPicBase of
                    Just Reg
    picBase -> Reg -> NatM Reg
    forall (m :: * -> *) a. Monad m => a -> m a
    return Reg
    picBase
                    Maybe Reg
    Nothing
                     -> do
                            Reg
    reg <- Format -> NatM Reg
    getNewRegNat Format
    rep
                            (NatM_State -> (Reg, NatM_State)) -> NatM Reg
    forall result. (NatM_State -> (result, NatM_State)) -> NatM result
    NatM (\NatM_State
    state -> (Reg
    reg, NatM_State
    state { natm_pic :: Maybe Reg
    natm_pic = Reg -> Maybe Reg
    forall a. a -> Maybe a
    Just Reg
    reg }))

    getModLoc :: NatM ModLocation
    getModLoc :: NatM ModLocation
    getModLoc
            = (NatM_State -> (ModLocation, NatM_State)) -> NatM ModLocation
    forall result. (NatM_State -> (result, NatM_State)) -> NatM result
    NatM ((NatM_State -> (ModLocation, NatM_State)) -> NatM ModLocation)
    -> (NatM_State -> (ModLocation, NatM_State)) -> NatM ModLocation
    forall a b. (a -> b) -> a -> b
    $ \ NatM_State
    st -> (NatM_State -> ModLocation
    natm_modloc NatM_State
    st, NatM_State
    st)

    -- | Get native code generator configuration
    getConfig :: NatM NCGConfig
    getConfig :: NatM NCGConfig
    getConfig = (NatM_State -> (NCGConfig, NatM_State)) -> NatM NCGConfig
    forall result. (NatM_State -> (result, NatM_State)) -> NatM result
    NatM ((NatM_State -> (NCGConfig, NatM_State)) -> NatM NCGConfig)
    -> (NatM_State -> (NCGConfig, NatM_State)) -> NatM NCGConfig
    forall a b. (a -> b) -> a -> b
    $ \NatM_State
    st -> (NatM_State -> NCGConfig
    natm_config NatM_State
    st, NatM_State
    st)

    -- | Get target platform from native code generator configuration
    getPlatform :: NatM Platform
    getPlatform :: NatM Platform
    getPlatform = NCGConfig -> Platform
    ncgPlatform (NCGConfig -> Platform) -> NatM NCGConfig -> NatM Platform
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NatM NCGConfig
    getConfig

    getFileId :: FastString -> NatM Int
    getFileId :: FastString -> NatM Int
    getFileId FastString
    f = (NatM_State -> (Int, NatM_State)) -> NatM Int
    forall result. (NatM_State -> (result, NatM_State)) -> NatM result
    NatM ((NatM_State -> (Int, NatM_State)) -> NatM Int)
    -> (NatM_State -> (Int, NatM_State)) -> NatM Int
    forall a b. (a -> b) -> a -> b
    $ \NatM_State
    st ->
      case DwarfFiles -> FastString -> Maybe (FastString, Int)
    forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM (NatM_State -> DwarfFiles
    natm_fileid NatM_State
    st) FastString
    f of
        Just (FastString
    _,Int
    n) -> (Int
    n, NatM_State
    st)
        Maybe (FastString, Int)
    Nothing    -> let n :: Int
    n = Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + DwarfFiles -> Int
    forall key elt. UniqFM key elt -> Int
    sizeUFM (NatM_State -> DwarfFiles
    natm_fileid NatM_State
    st)
                          fids :: DwarfFiles
    fids = DwarfFiles -> FastString -> (FastString, Int) -> DwarfFiles
    forall key elt.
    Uniquable key =>
    UniqFM key elt -> key -> elt -> UniqFM key elt
    addToUFM (NatM_State -> DwarfFiles
    natm_fileid NatM_State
    st) FastString
    f (FastString
    f,Int
    n)
                      in Int
    n Int -> (Int, NatM_State) -> (Int, NatM_State)
    `seq` DwarfFiles
    fids DwarfFiles -> (Int, NatM_State) -> (Int, NatM_State)
    `seq` (Int
    n, NatM_State
    st { natm_fileid :: DwarfFiles
    natm_fileid = DwarfFiles
    fids  })

    getDebugBlock :: Label -> NatM (Maybe DebugBlock)
    getDebugBlock :: BlockId -> NatM (Maybe DebugBlock)
    getDebugBlock BlockId
    l = (NatM_State -> (Maybe DebugBlock, NatM_State))
    -> NatM (Maybe DebugBlock)
    forall result. (NatM_State -> (result, NatM_State)) -> NatM result
    NatM ((NatM_State -> (Maybe DebugBlock, NatM_State))
     -> NatM (Maybe DebugBlock))
    -> (NatM_State -> (Maybe DebugBlock, NatM_State))
    -> NatM (Maybe DebugBlock)
    forall a b. (a -> b) -> a -> b
    $ \NatM_State
    st -> (KeyOf LabelMap -> LabelMap DebugBlock -> Maybe DebugBlock
    forall (map :: * -> *) a.
    IsMap map =>
    KeyOf map -> map a -> Maybe a
    mapLookup KeyOf LabelMap
    BlockId
    l (NatM_State -> LabelMap DebugBlock
    natm_debug_map NatM_State
    st), NatM_State
    st)