{-# 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 -> 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 = 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 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 = forall a. a -> NatM a
returnNat
      <*> :: forall a 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
(>>=) = forall a b. NatM a -> (a -> NatM b) -> NatM b
thenNat

instance MonadUnique NatM where
  getUniqueSupplyM :: NatM UniqSupply
getUniqueSupplyM = forall result. (NatM_State -> (result, NatM_State)) -> NatM result
NatM 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 = forall result. (NatM_State -> (result, NatM_State)) -> NatM result
NatM 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
        = forall result. (NatM_State -> (result, NatM_State)) -> NatM result
NatM forall a b. (a -> b) -> a -> b
$ \NatM_State
st -> case forall a. NatM a -> NatM_State -> (a, NatM_State)
unNat NatM a
expr NatM_State
st of
                        (a
result, NatM_State
st') -> 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
        = forall result. (NatM_State -> (result, NatM_State)) -> NatM result
NatM 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 []
  = 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) <- 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
       forall (m :: * -> *) a. Monad m => a -> m a
return (acc
b__3, y
x__2forall a. a -> [a] -> [a]
:[y]
xs__2)

getUniqueNat :: NatM Unique
getUniqueNat :: NatM Unique
getUniqueNat = forall result. (NatM_State -> (result, NatM_State)) -> NatM result
NatM forall a b. (a -> b) -> a -> b
$ \ NatM_State
st ->
    case UniqSupply -> (Unique, UniqSupply)
takeUniqFromSupply 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 = forall result. (NatM_State -> (result, NatM_State)) -> NatM result
NatM 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 = forall result. (NatM_State -> (result, NatM_State)) -> NatM result
NatM 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 = forall result. (NatM_State -> (result, NatM_State)) -> NatM result
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 = forall result. (NatM_State -> (result, NatM_State)) -> NatM result
NatM forall a b. (a -> b) -> a -> b
$ \ NatM_State
st -> (NCGConfig -> Module
ncgThisModule 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
        = forall result. (NatM_State -> (result, NatM_State)) -> NatM result
NatM forall a b. (a -> b) -> a -> b
$ \ NatM_State
st -> ((), NatM_State
st {natm_imports :: [CLabel]
natm_imports = CLabel
imp 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
        = forall result. (NatM_State -> (result, NatM_State)) -> NatM result
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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          BlockId -> BlockId -> EdgeWeight -> CFG -> CFG
addWeightEdge BlockId
between BlockId
old EdgeWeight
weight forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          BlockId -> BlockId -> CFG -> CFG
delEdge BlockId
from BlockId
old forall a b. (a -> b) -> a -> b
$ CFG
m
        | Bool
otherwise
        = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Failed to update cfg: Untracked edge" (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
        forall (m :: * -> *) a. Monad m => a -> m a
return (Unique -> BlockId
mkBlockId Unique
u)


getNewLabelNat :: NatM CLabel
getNewLabelNat :: NatM CLabel
getNewLabelNat
 = BlockId -> CLabel
blockLbl 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
      forall (m :: * -> *) a. Monad m => a -> m a
return (VirtualReg -> Reg
RegVirtual 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 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 forall a b. (a -> b) -> a -> b
$ VirtualReg -> VirtualReg
getHiVirtualRegFromLo VirtualReg
vLo
      forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
lo, Reg
hi)


getPicBaseMaybeNat :: NatM (Maybe Reg)
getPicBaseMaybeNat :: NatM (Maybe Reg)
getPicBaseMaybeNat
        = 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return Reg
picBase
                Maybe Reg
Nothing
                 -> do
                        Reg
reg <- Format -> NatM Reg
getNewRegNat Format
rep
                        forall result. (NatM_State -> (result, NatM_State)) -> NatM result
NatM (\NatM_State
state -> (Reg
reg, NatM_State
state { natm_pic :: Maybe Reg
natm_pic = forall a. a -> Maybe a
Just Reg
reg }))

getModLoc :: NatM ModLocation
getModLoc :: NatM ModLocation
getModLoc
        = forall result. (NatM_State -> (result, NatM_State)) -> NatM result
NatM 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 = forall result. (NatM_State -> (result, NatM_State)) -> NatM result
NatM 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 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 = forall result. (NatM_State -> (result, NatM_State)) -> NatM result
NatM forall a b. (a -> b) -> a -> b
$ \NatM_State
st ->
  case 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 forall a. Num a => a -> a -> a
+ forall key elt. UniqFM key elt -> Int
sizeUFM (NatM_State -> DwarfFiles
natm_fileid NatM_State
st)
                      fids :: DwarfFiles
fids = 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 seq :: forall a b. a -> b -> b
`seq` DwarfFiles
fids seq :: forall a b. a -> b -> b
`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 = forall result. (NatM_State -> (result, NatM_State)) -> NatM result
NatM forall a b. (a -> b) -> a -> b
$ \NatM_State
st -> (forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup BlockId
l (NatM_State -> LabelMap DebugBlock
natm_debug_map NatM_State
st), NatM_State
st)