{-# LANGUAGE CPP #-} -- ----------------------------------------------------------------------------- -- -- (c) The University of Glasgow 1993-2004 -- -- The native code generator's monad. -- -- ----------------------------------------------------------------------------- module NCGMonad ( NcgImpl(..), NatM_State(..), mkNatM_State, NatM, -- instance Monad initNat, addImportNat, addNodeBetweenNat, addImmediateSuccessorNat, updateCfgNat, getUniqueNat, mapAccumLNat, setDeltaNat, getDeltaNat, getThisModuleNat, getBlockIdNat, getNewLabelNat, getNewRegNat, getNewRegPairNat, getPicBaseMaybeNat, getPicBaseNat, getDynFlags, getModLoc, getFileId, getDebugBlock, DwarfFiles ) where #include "HsVersions.h" import GhcPrelude import Reg import Format import TargetReg import BlockId import Hoopl.Collections import Hoopl.Label import CLabel ( CLabel ) import Debug import FastString ( FastString ) import UniqFM import UniqSupply import Unique ( Unique ) import DynFlags import Module import Control.Monad ( liftM, ap ) import Instruction import Outputable (SDoc, pprPanic, ppr) import Cmm (RawCmmDecl, CmmStatics) import CFG data NcgImpl statics instr jumpDest = NcgImpl { NcgImpl statics instr jumpDest -> RawCmmDecl -> NatM [NatCmmDecl statics instr] cmmTopCodeGen :: RawCmmDecl -> NatM [NatCmmDecl statics instr], NcgImpl statics instr jumpDest -> instr -> Maybe (NatCmmDecl statics instr) generateJumpTableForInstr :: instr -> Maybe (NatCmmDecl statics instr), NcgImpl statics instr jumpDest -> jumpDest -> Maybe BlockId getJumpDestBlockId :: jumpDest -> Maybe BlockId, NcgImpl statics instr jumpDest -> instr -> Maybe jumpDest canShortcut :: instr -> Maybe jumpDest, NcgImpl statics instr jumpDest -> (BlockId -> Maybe jumpDest) -> statics -> statics shortcutStatics :: (BlockId -> Maybe jumpDest) -> statics -> statics, NcgImpl statics instr jumpDest -> (BlockId -> Maybe jumpDest) -> instr -> instr shortcutJump :: (BlockId -> Maybe jumpDest) -> instr -> instr, NcgImpl statics instr jumpDest -> NatCmmDecl statics instr -> SDoc pprNatCmmDecl :: NatCmmDecl statics instr -> SDoc, NcgImpl statics instr jumpDest -> Int maxSpillSlots :: Int, NcgImpl statics instr jumpDest -> [RealReg] allocatableRegs :: [RealReg], NcgImpl statics instr jumpDest -> [NatCmmDecl statics instr] -> [NatCmmDecl statics instr] ncg_x86fp_kludge :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr], NcgImpl statics instr jumpDest -> [NatCmmDecl statics instr] -> [NatCmmDecl statics instr] ncgExpandTop :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr], 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. NcgImpl statics instr jumpDest -> LabelMap CmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr] ncgMakeFarBranches :: LabelMap CmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr], 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 Debug -- and Note [Unwinding information in the NCG] in this module. NcgImpl statics instr jumpDest -> CFG -> LabelMap CmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr] invertCondBranches :: CFG -> LabelMap CmmStatics -> [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 -> DynFlags natm_dflags :: DynFlags, NatM_State -> Module natm_this_module :: Module, 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, Int) newtype NatM result = NatM (NatM_State -> (result, NatM_State)) unNat :: NatM a -> NatM_State -> (a, NatM_State) unNat :: NatM a -> NatM_State -> (a, NatM_State) unNat (NatM a :: NatM_State -> (a, NatM_State) a) = NatM_State -> (a, NatM_State) a mkNatM_State :: UniqSupply -> Int -> DynFlags -> Module -> ModLocation -> DwarfFiles -> LabelMap DebugBlock -> CFG -> NatM_State mkNatM_State :: UniqSupply -> Int -> DynFlags -> Module -> ModLocation -> DwarfFiles -> LabelMap DebugBlock -> CFG -> NatM_State mkNatM_State us :: UniqSupply us delta :: Int delta dflags :: DynFlags dflags this_mod :: Module this_mod = \loc :: ModLocation loc dwf :: DwarfFiles dwf dbg :: LabelMap DebugBlock dbg cfg :: CFG cfg -> NatM_State :: UniqSupply -> Int -> [CLabel] -> Maybe Reg -> DynFlags -> Module -> ModLocation -> DwarfFiles -> LabelMap DebugBlock -> CFG -> NatM_State 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_dflags :: DynFlags natm_dflags = DynFlags dflags , natm_this_module :: Module natm_this_module = Module this_mod , 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 :: NatM_State -> NatM a -> (a, NatM_State) initNat init_st :: NatM_State init_st m :: 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 { (r :: a r,st :: NatM_State st) -> (a r,NatM_State st) } instance Functor NatM where fmap :: (a -> b) -> NatM a -> NatM b fmap = (a -> b) -> NatM a -> NatM b forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r liftM instance Applicative NatM where pure :: a -> NatM a pure = a -> NatM a forall a. a -> NatM a returnNat <*> :: 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 >>= :: 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 $ \st :: NatM_State st -> case UniqSupply -> (UniqSupply, UniqSupply) splitUniqSupply (NatM_State -> UniqSupply natm_us NatM_State st) of (us1 :: UniqSupply us1, us2 :: 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 $ \st :: NatM_State st -> case UniqSupply -> (Unique, UniqSupply) takeUniqFromSupply (NatM_State -> UniqSupply natm_us NatM_State st) of (uniq :: Unique uniq, us' :: UniqSupply us') -> (Unique uniq, NatM_State st {natm_us :: UniqSupply natm_us = UniqSupply us'}) thenNat :: NatM a -> (a -> NatM b) -> NatM b thenNat :: NatM a -> (a -> NatM b) -> NatM b thenNat expr :: NatM a expr cont :: 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 $ \st :: 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 (result :: a result, st' :: 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 :: a -> NatM a returnNat result :: 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 $ \st :: NatM_State st -> (a result, NatM_State st) mapAccumLNat :: (acc -> x -> NatM (acc, y)) -> acc -> [x] -> NatM (acc, [y]) mapAccumLNat :: (acc -> x -> NatM (acc, y)) -> acc -> [x] -> NatM (acc, [y]) mapAccumLNat _ b :: acc b [] = (acc, [y]) -> NatM (acc, [y]) forall (m :: * -> *) a. Monad m => a -> m a return (acc b, []) mapAccumLNat f :: acc -> x -> NatM (acc, y) f b :: acc b (x :: x x:xs :: [x] xs) = do (b__2 :: acc b__2, x__2 :: y x__2) <- acc -> x -> NatM (acc, y) f acc b x x (b__3 :: acc b__3, xs__2 :: [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 $ \ st :: 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 (uniq :: Unique uniq, us' :: UniqSupply us') -> (Unique uniq, NatM_State st {natm_us :: UniqSupply natm_us = UniqSupply us'}) instance HasDynFlags NatM where getDynFlags :: NatM DynFlags getDynFlags = (NatM_State -> (DynFlags, NatM_State)) -> NatM DynFlags forall result. (NatM_State -> (result, NatM_State)) -> NatM result NatM ((NatM_State -> (DynFlags, NatM_State)) -> NatM DynFlags) -> (NatM_State -> (DynFlags, NatM_State)) -> NatM DynFlags forall a b. (a -> b) -> a -> b $ \ st :: NatM_State st -> (NatM_State -> DynFlags natm_dflags NatM_State st, NatM_State st) 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 $ \ st :: NatM_State st -> (NatM_State -> Int natm_delta NatM_State st, NatM_State st) setDeltaNat :: Int -> NatM () setDeltaNat :: Int -> NatM () setDeltaNat delta :: 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 $ \ st :: 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 $ \ st :: NatM_State st -> (NatM_State -> Module natm_this_module NatM_State st, NatM_State st) addImportNat :: CLabel -> NatM () addImportNat :: CLabel -> NatM () addImportNat imp :: 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 $ \ st :: 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 f :: 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 $ \ st :: NatM_State st -> ((), NatM_State st { natm_cfg :: CFG natm_cfg = CFG -> CFG f (NatM_State -> CFG natm_cfg NatM_State st) }) -- | Record that we added a block between `from` and `old`. addNodeBetweenNat :: BlockId -> BlockId -> BlockId -> NatM () addNodeBetweenNat :: BlockId -> BlockId -> BlockId -> NatM () addNodeBetweenNat from :: BlockId from between :: BlockId between to :: BlockId to = do DynFlags df <- NatM DynFlags forall (m :: * -> *). HasDynFlags m => m DynFlags getDynFlags let jmpWeight :: EdgeWeight jmpWeight = Int -> EdgeWeight forall a b. (Integral a, Num b) => a -> b fromIntegral (Int -> EdgeWeight) -> (DynFlags -> Int) -> DynFlags -> EdgeWeight forall b c a. (b -> c) -> (a -> b) -> a -> c . CfgWeights -> Int uncondWeight (CfgWeights -> Int) -> (DynFlags -> CfgWeights) -> DynFlags -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . DynFlags -> CfgWeights cfgWeightInfo (DynFlags -> EdgeWeight) -> DynFlags -> EdgeWeight forall a b. (a -> b) -> a -> b $ DynFlags df (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 weight :: EdgeWeight weight from :: BlockId from between :: BlockId between old :: BlockId old m :: CFG m | Just info :: 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 "Faild 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 block :: BlockId block succ :: BlockId succ = (CFG -> CFG) -> NatM () updateCfgNat (BlockId -> BlockId -> CFG -> CFG addImmediateSuccessor 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 rep :: Format rep = do Unique u <- NatM Unique getUniqueNat DynFlags dflags <- NatM DynFlags forall (m :: * -> *). HasDynFlags m => m DynFlags getDynFlags 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 (DynFlags -> Platform targetPlatform DynFlags dflags) Unique u Format rep) getNewRegPairNat :: Format -> NatM (Reg,Reg) getNewRegPairNat :: Format -> NatM (Reg, Reg) getNewRegPairNat rep :: Format rep = do Unique u <- NatM Unique getUniqueNat DynFlags dflags <- NatM DynFlags forall (m :: * -> *). HasDynFlags m => m DynFlags getDynFlags let vLo :: VirtualReg vLo = Platform -> Unique -> Format -> VirtualReg targetMkVirtualReg (DynFlags -> Platform targetPlatform DynFlags dflags) 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 (DynFlags -> Platform targetPlatform DynFlags dflags) 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 (\state :: NatM_State state -> (NatM_State -> Maybe Reg natm_pic NatM_State state, NatM_State state)) getPicBaseNat :: Format -> NatM Reg getPicBaseNat :: Format -> NatM Reg getPicBaseNat rep :: Format rep = do Maybe Reg mbPicBase <- NatM (Maybe Reg) getPicBaseMaybeNat case Maybe Reg mbPicBase of Just picBase :: Reg picBase -> Reg -> NatM Reg forall (m :: * -> *) a. Monad m => a -> m a return Reg picBase 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 (\state :: 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 $ \ st :: NatM_State st -> (NatM_State -> ModLocation natm_modloc NatM_State st, NatM_State st) getFileId :: FastString -> NatM Int getFileId :: FastString -> NatM Int getFileId f :: 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 $ \st :: NatM_State st -> case DwarfFiles -> FastString -> Maybe (FastString, Int) forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt lookupUFM (NatM_State -> DwarfFiles natm_fileid NatM_State st) FastString f of Just (_,n :: Int n) -> (Int n, NatM_State st) Nothing -> let n :: Int n = 1 Int -> Int -> Int forall a. Num a => a -> a -> a + DwarfFiles -> Int forall elt. UniqFM 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 elt -> key -> elt -> UniqFM 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) forall a b. a -> b -> b `seq` DwarfFiles fids DwarfFiles -> (Int, NatM_State) -> (Int, NatM_State) 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 l :: 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 $ \st :: 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)