{-# LANGUAGE GADTs         #-}
module GHC.Driver.GenerateCgIPEStub (generateCgIPEStub, lookupEstimatedTicks) where
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Semigroup ((<>))
import GHC.Cmm
import GHC.Cmm.CLabel (CLabel, mkAsmTempLabel)
import GHC.Cmm.Dataflow (O)
import GHC.Cmm.Dataflow.Block (blockSplit, blockToList)
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Label (Label)
import GHC.Cmm.Info.Build (emptySRT)
import GHC.Cmm.Pipeline (cmmPipeline)
import GHC.Data.Stream (Stream, liftIO)
import qualified GHC.Data.Stream as Stream
import GHC.Driver.Env (hsc_dflags, hsc_logger)
import GHC.Driver.Env.Types (HscEnv)
import GHC.Driver.Flags (GeneralFlag (..), DumpFlag(Opt_D_ipe_stats))
import GHC.Driver.Session (gopt, targetPlatform)
import GHC.Driver.Config.StgToCmm
import GHC.Driver.Config.Cmm
import GHC.Prelude
import GHC.Runtime.Heap.Layout (isStackRep)
import GHC.Settings (platformTablesNextToCode)
import GHC.StgToCmm.Monad (getCmm, initC, runC, initFCodeState)
import GHC.StgToCmm.Prof (initInfoTableProv)
import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos)
import GHC.StgToCmm.Utils
import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation)
import GHC.Types.Name.Set (NonCaffySet)
import GHC.Types.Tickish (GenTickish (SourceNote))
import GHC.Unit.Types (Module, moduleName)
import GHC.Unit.Module (moduleNameString)
import qualified GHC.Utils.Logger as Logger
import GHC.Utils.Outputable (ppr)
generateCgIPEStub
  :: HscEnv
  -> Module
  -> InfoTableProvMap
  -> ( NonCaffySet
     , ModuleLFInfos
     , Map CmmInfoTable (Maybe IpeSourceLocation)
     , IPEStats
     )
  -> Stream IO CmmGroupSRTs CmmCgInfos
generateCgIPEStub :: HscEnv
-> Module
-> InfoTableProvMap
-> (NonCaffySet, ModuleLFInfos,
    Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> Stream IO CmmGroupSRTs CmmCgInfos
generateCgIPEStub HscEnv
hsc_env Module
this_mod InfoTableProvMap
denv (NonCaffySet
nonCaffySet, ModuleLFInfos
moduleLFInfos, Map CmmInfoTable (Maybe IpeSourceLocation)
infoTablesWithTickishes, IPEStats
initStats) = do
  let dflags :: DynFlags
dflags   = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
      platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
      logger :: Logger
logger   = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
      fstate :: FCodeState
fstate   = Platform -> FCodeState
initFCodeState Platform
platform
      cmm_cfg :: CmmConfig
cmm_cfg  = DynFlags -> CmmConfig
initCmmConfig DynFlags
dflags
  CgState
cgState <- IO CgState -> Stream IO CmmGroupSRTs CgState
forall a. IO a -> Stream IO CmmGroupSRTs a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO CgState
initC
  
  let denv' :: InfoTableProvMap
denv' = InfoTableProvMap
denv {provInfoTables = Map.mapKeys cit_lbl infoTablesWithTickishes}
      ((Maybe (IPEStats, CStub)
mIpeStub, CmmGroup
ipeCmmGroup), CgState
_) = StgToCmmConfig
-> FCodeState
-> CgState
-> FCode (Maybe (IPEStats, CStub), CmmGroup)
-> ((Maybe (IPEStats, CStub), CmmGroup), CgState)
forall a.
StgToCmmConfig -> FCodeState -> CgState -> FCode a -> (a, CgState)
runC (DynFlags -> Module -> StgToCmmConfig
initStgToCmmConfig DynFlags
dflags Module
this_mod) FCodeState
fstate CgState
cgState (FCode (Maybe (IPEStats, CStub), CmmGroup)
 -> ((Maybe (IPEStats, CStub), CmmGroup), CgState))
-> FCode (Maybe (IPEStats, CStub), CmmGroup)
-> ((Maybe (IPEStats, CStub), CmmGroup), CgState)
forall a b. (a -> b) -> a -> b
$ FCode (Maybe (IPEStats, CStub))
-> FCode (Maybe (IPEStats, CStub), CmmGroup)
forall a. FCode a -> FCode (a, CmmGroup)
getCmm (IPEStats
-> [CmmInfoTable]
-> InfoTableProvMap
-> FCode (Maybe (IPEStats, CStub))
initInfoTableProv IPEStats
initStats (Map CmmInfoTable (Maybe IpeSourceLocation) -> [CmmInfoTable]
forall k a. Map k a -> [k]
Map.keys Map CmmInfoTable (Maybe IpeSourceLocation)
infoTablesWithTickishes) InfoTableProvMap
denv')
  (ModuleSRTInfo
_, CmmGroupSRTs
ipeCmmGroupSRTs) <- IO (ModuleSRTInfo, CmmGroupSRTs)
-> Stream IO CmmGroupSRTs (ModuleSRTInfo, CmmGroupSRTs)
forall a. IO a -> Stream IO CmmGroupSRTs a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ModuleSRTInfo, CmmGroupSRTs)
 -> Stream IO CmmGroupSRTs (ModuleSRTInfo, CmmGroupSRTs))
-> IO (ModuleSRTInfo, CmmGroupSRTs)
-> Stream IO CmmGroupSRTs (ModuleSRTInfo, CmmGroupSRTs)
forall a b. (a -> b) -> a -> b
$ Logger
-> CmmConfig
-> ModuleSRTInfo
-> CmmGroup
-> IO (ModuleSRTInfo, CmmGroupSRTs)
cmmPipeline Logger
logger CmmConfig
cmm_cfg (Module -> ModuleSRTInfo
emptySRT Module
this_mod) CmmGroup
ipeCmmGroup
  CmmGroupSRTs -> Stream IO CmmGroupSRTs ()
forall (m :: * -> *) a. Monad m => a -> Stream m a ()
Stream.yield CmmGroupSRTs
ipeCmmGroupSRTs
  CStub
ipeStub <-
    case Maybe (IPEStats, CStub)
mIpeStub of
      Just (IPEStats
stats, CStub
stub) -> do
        
        IO () -> Stream IO CmmGroupSRTs ()
forall a. IO a -> Stream IO CmmGroupSRTs a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Stream IO CmmGroupSRTs ())
-> IO () -> Stream IO CmmGroupSRTs ()
forall a b. (a -> b) -> a -> b
$
          Logger -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
Logger.putDumpFileMaybe Logger
logger
            DumpFlag
Opt_D_ipe_stats
            (String
"IPE Stats for module " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ModuleName -> String
moduleNameString (ModuleName -> String) -> ModuleName -> String
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
this_mod))
            DumpFormat
Logger.FormatText
            (IPEStats -> SDoc
forall a. Outputable a => a -> SDoc
ppr IPEStats
stats)
        CStub -> Stream IO CmmGroupSRTs CStub
forall a. a -> Stream IO CmmGroupSRTs a
forall (m :: * -> *) a. Monad m => a -> m a
return CStub
stub
      Maybe (IPEStats, CStub)
Nothing -> CStub -> Stream IO CmmGroupSRTs CStub
forall a. a -> Stream IO CmmGroupSRTs a
forall (m :: * -> *) a. Monad m => a -> m a
return CStub
forall a. Monoid a => a
mempty
  CmmCgInfos -> Stream IO CmmGroupSRTs CmmCgInfos
forall a. a -> Stream IO CmmGroupSRTs a
forall (m :: * -> *) a. Monad m => a -> m a
return CmmCgInfos {cgNonCafs :: NonCaffySet
cgNonCafs = NonCaffySet
nonCaffySet, cgLFInfos :: ModuleLFInfos
cgLFInfos = ModuleLFInfos
moduleLFInfos, cgIPEStub :: CStub
cgIPEStub = CStub
ipeStub}
lookupEstimatedTicks
  :: HscEnv
  -> Map CmmInfoTable (Maybe IpeSourceLocation)
  -> IPEStats
  -> CmmGroupSRTs
  -> IO (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
lookupEstimatedTicks :: HscEnv
-> Map CmmInfoTable (Maybe IpeSourceLocation)
-> IPEStats
-> CmmGroupSRTs
-> IO (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
lookupEstimatedTicks HscEnv
hsc_env Map CmmInfoTable (Maybe IpeSourceLocation)
ipes IPEStats
stats CmmGroupSRTs
cmm_group_srts =
    
    
    
    
    
    
    
    
    
    (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> IO (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
 -> IO (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats))
-> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> IO (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
forall a b. (a -> b) -> a -> b
$ ((Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
 -> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
 -> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats))
-> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> CmmGroupSRTs
-> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
collectInfoTables (Map CmmInfoTable (Maybe IpeSourceLocation)
ipes, IPEStats
stats) CmmGroupSRTs
cmm_group_srts
  where
    dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
    platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
    
    
    
    
    
    
    
    labelsToSources :: Map CLabel IpeSourceLocation
    labelsToSources :: Map CLabel IpeSourceLocation
labelsToSources =
      if Platform -> Bool
platformTablesNextToCode Platform
platform then
        (Map CLabel IpeSourceLocation
 -> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
 -> Map CLabel IpeSourceLocation)
-> Map CLabel IpeSourceLocation
-> CmmGroupSRTs
-> Map CLabel IpeSourceLocation
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map CLabel IpeSourceLocation
-> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> Map CLabel IpeSourceLocation
labelsToSourcesWithTNTC Map CLabel IpeSourceLocation
forall k a. Map k a
Map.empty CmmGroupSRTs
cmm_group_srts
      else
        (Map CLabel IpeSourceLocation
 -> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
 -> Map CLabel IpeSourceLocation)
-> Map CLabel IpeSourceLocation
-> CmmGroupSRTs
-> Map CLabel IpeSourceLocation
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map CLabel IpeSourceLocation
-> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> Map CLabel IpeSourceLocation
labelsToSourcesSansTNTC Map CLabel IpeSourceLocation
forall k a. Map k a
Map.empty CmmGroupSRTs
cmm_group_srts
    collectInfoTables
      :: (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
      -> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
      -> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
    collectInfoTables :: (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
collectInfoTables (!Map CmmInfoTable (Maybe IpeSourceLocation)
acc, !IPEStats
stats) (CmmProc CmmTopInfo
h CLabel
_ [GlobalReg]
_ CmmGraph
_) =
        ((Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
 -> KeyOf LabelMap
 -> CmmInfoTable
 -> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats))
-> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> LabelMap CmmInfoTable
-> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
forall b a. (b -> KeyOf LabelMap -> a -> b) -> b -> LabelMap a -> b
forall (map :: * -> *) b a.
IsMap map =>
(b -> KeyOf map -> a -> b) -> b -> map a -> b
mapFoldlWithKey (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> KeyOf LabelMap
-> CmmInfoTable
-> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
(Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> Label
-> CmmInfoTable
-> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
go (Map CmmInfoTable (Maybe IpeSourceLocation)
acc, IPEStats
stats) (CmmTopInfo -> LabelMap CmmInfoTable
info_tbls CmmTopInfo
h)
      where
        go :: (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
           -> Label
           -> CmmInfoTable
           -> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
        go :: (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> Label
-> CmmInfoTable
-> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
go (!Map CmmInfoTable (Maybe IpeSourceLocation)
acc, !IPEStats
stats) Label
lbl' CmmInfoTable
tbl =
          let
            lbl :: CLabel
lbl =
              if Platform -> Bool
platformTablesNextToCode Platform
platform then
                
                
                Label -> CLabel
forall a. Uniquable a => a -> CLabel
mkAsmTempLabel Label
lbl'
              else
                
                
                CmmInfoTable -> CLabel
cit_lbl CmmInfoTable
tbl
          in
            if (SMRep -> Bool
isStackRep (SMRep -> Bool) -> (CmmInfoTable -> SMRep) -> CmmInfoTable -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmInfoTable -> SMRep
cit_rep) CmmInfoTable
tbl then
              if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_InfoTableMapWithStack DynFlags
dflags then
                
                
                (CmmInfoTable
-> Maybe IpeSourceLocation
-> Map CmmInfoTable (Maybe IpeSourceLocation)
-> Map CmmInfoTable (Maybe IpeSourceLocation)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CmmInfoTable
tbl (CLabel -> Map CLabel IpeSourceLocation -> Maybe IpeSourceLocation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CLabel
lbl Map CLabel IpeSourceLocation
labelsToSources) Map CmmInfoTable (Maybe IpeSourceLocation)
acc, IPEStats
stats)
              else
                
                
                
                (Map CmmInfoTable (Maybe IpeSourceLocation)
acc, IPEStats
stats IPEStats -> IPEStats -> IPEStats
forall a. Semigroup a => a -> a -> a
<> IPEStats
skippedIpeStats)
            else
              
              
              (CmmInfoTable
-> Maybe IpeSourceLocation
-> Map CmmInfoTable (Maybe IpeSourceLocation)
-> Map CmmInfoTable (Maybe IpeSourceLocation)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CmmInfoTable
tbl Maybe IpeSourceLocation
forall a. Maybe a
Nothing Map CmmInfoTable (Maybe IpeSourceLocation)
acc, IPEStats
stats)
    collectInfoTables (!Map CmmInfoTable (Maybe IpeSourceLocation)
acc, !IPEStats
stats) GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
_ = (Map CmmInfoTable (Maybe IpeSourceLocation)
acc, IPEStats
stats)
labelsToSourcesWithTNTC
  :: Map CLabel IpeSourceLocation
  -> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
  -> Map CLabel IpeSourceLocation
labelsToSourcesWithTNTC :: Map CLabel IpeSourceLocation
-> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> Map CLabel IpeSourceLocation
labelsToSourcesWithTNTC Map CLabel IpeSourceLocation
acc (CmmProc CmmTopInfo
_ CLabel
_ [GlobalReg]
_ CmmGraph
cmm_graph) =
    (Map CLabel IpeSourceLocation
 -> CmmBlock -> Map CLabel IpeSourceLocation)
-> Map CLabel IpeSourceLocation
-> [CmmBlock]
-> Map CLabel IpeSourceLocation
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map CLabel IpeSourceLocation
-> CmmBlock -> Map CLabel IpeSourceLocation
go Map CLabel IpeSourceLocation
acc (CmmGraph -> [CmmBlock]
toBlockList CmmGraph
cmm_graph)
  where
    go :: Map CLabel IpeSourceLocation -> CmmBlock -> Map CLabel IpeSourceLocation
    go :: Map CLabel IpeSourceLocation
-> CmmBlock -> Map CLabel IpeSourceLocation
go Map CLabel IpeSourceLocation
acc CmmBlock
block =
        case (,) (CLabel -> IpeSourceLocation -> (CLabel, IpeSourceLocation))
-> Maybe CLabel
-> Maybe (IpeSourceLocation -> (CLabel, IpeSourceLocation))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CLabel
returnFrameLabel Maybe (IpeSourceLocation -> (CLabel, IpeSourceLocation))
-> Maybe IpeSourceLocation -> Maybe (CLabel, IpeSourceLocation)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe IpeSourceLocation
lastTickInBlock of
          Just (CLabel
clabel, IpeSourceLocation
src_loc) -> CLabel
-> IpeSourceLocation
-> Map CLabel IpeSourceLocation
-> Map CLabel IpeSourceLocation
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CLabel
clabel IpeSourceLocation
src_loc Map CLabel IpeSourceLocation
acc
          Maybe (CLabel, IpeSourceLocation)
Nothing -> Map CLabel IpeSourceLocation
acc
      where
        (CmmNode C O
_, Block CmmNode O O
middleBlock, CmmNode O C
endBlock) = CmmBlock -> (CmmNode C O, Block CmmNode O O, CmmNode O C)
forall (n :: Extensibility -> Extensibility -> *).
Block n C C -> (n C O, Block n O O, n O C)
blockSplit CmmBlock
block
        returnFrameLabel :: Maybe CLabel
        returnFrameLabel :: Maybe CLabel
returnFrameLabel =
          case CmmNode O C
endBlock of
            (CmmCall CmmExpr
_ (Just Label
l) [GlobalReg]
_ ByteOff
_ ByteOff
_ ByteOff
_) -> CLabel -> Maybe CLabel
forall a. a -> Maybe a
Just (CLabel -> Maybe CLabel) -> CLabel -> Maybe CLabel
forall a b. (a -> b) -> a -> b
$ Label -> CLabel
forall a. Uniquable a => a -> CLabel
mkAsmTempLabel Label
l
            CmmNode O C
_ -> Maybe CLabel
forall a. Maybe a
Nothing
        lastTickInBlock :: Maybe IpeSourceLocation
lastTickInBlock = (CmmNode O O -> Maybe IpeSourceLocation -> Maybe IpeSourceLocation)
-> Maybe IpeSourceLocation
-> [CmmNode O O]
-> Maybe IpeSourceLocation
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CmmNode O O -> Maybe IpeSourceLocation -> Maybe IpeSourceLocation
maybeTick Maybe IpeSourceLocation
forall a. Maybe a
Nothing (Block CmmNode O O -> [CmmNode O O]
forall (n :: Extensibility -> Extensibility -> *).
Block n O O -> [n O O]
blockToList Block CmmNode O O
middleBlock)
        maybeTick :: CmmNode O O -> Maybe IpeSourceLocation -> Maybe IpeSourceLocation
        maybeTick :: CmmNode O O -> Maybe IpeSourceLocation -> Maybe IpeSourceLocation
maybeTick CmmNode O O
_ s :: Maybe IpeSourceLocation
s@(Just IpeSourceLocation
_) = Maybe IpeSourceLocation
s
        maybeTick (CmmTick (SourceNote RealSrcSpan
span String
name)) Maybe IpeSourceLocation
Nothing = IpeSourceLocation -> Maybe IpeSourceLocation
forall a. a -> Maybe a
Just (RealSrcSpan
span, String
name)
        maybeTick CmmNode O O
_ Maybe IpeSourceLocation
_ = Maybe IpeSourceLocation
forall a. Maybe a
Nothing
labelsToSourcesWithTNTC Map CLabel IpeSourceLocation
acc GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
_ = Map CLabel IpeSourceLocation
acc
labelsToSourcesSansTNTC
  :: Map CLabel IpeSourceLocation
  -> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
  -> Map CLabel IpeSourceLocation
labelsToSourcesSansTNTC :: Map CLabel IpeSourceLocation
-> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> Map CLabel IpeSourceLocation
labelsToSourcesSansTNTC Map CLabel IpeSourceLocation
acc (CmmProc CmmTopInfo
_ CLabel
_ [GlobalReg]
_ CmmGraph
cmm_graph) =
    (Map CLabel IpeSourceLocation
 -> CmmBlock -> Map CLabel IpeSourceLocation)
-> Map CLabel IpeSourceLocation
-> [CmmBlock]
-> Map CLabel IpeSourceLocation
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map CLabel IpeSourceLocation
-> CmmBlock -> Map CLabel IpeSourceLocation
go Map CLabel IpeSourceLocation
acc (CmmGraph -> [CmmBlock]
toBlockList CmmGraph
cmm_graph)
  where
    go :: Map CLabel IpeSourceLocation -> CmmBlock -> Map CLabel IpeSourceLocation
    go :: Map CLabel IpeSourceLocation
-> CmmBlock -> Map CLabel IpeSourceLocation
go Map CLabel IpeSourceLocation
acc CmmBlock
block = (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
-> Map CLabel IpeSourceLocation
forall a b. (a, b) -> a
fst ((Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
 -> Map CLabel IpeSourceLocation)
-> (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
-> Map CLabel IpeSourceLocation
forall a b. (a -> b) -> a -> b
$ ((Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
 -> CmmNode O O
 -> (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation))
-> (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
-> [CmmNode O O]
-> (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
-> CmmNode O O
-> (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
collectLabels (Map CLabel IpeSourceLocation
acc, Maybe IpeSourceLocation
forall a. Maybe a
Nothing) (Block CmmNode O O -> [CmmNode O O]
forall (n :: Extensibility -> Extensibility -> *).
Block n O O -> [n O O]
blockToList Block CmmNode O O
middleBlock)
      where
        (CmmNode C O
_, Block CmmNode O O
middleBlock, CmmNode O C
_) = CmmBlock -> (CmmNode C O, Block CmmNode O O, CmmNode O C)
forall (n :: Extensibility -> Extensibility -> *).
Block n C C -> (n C O, Block n O O, n O C)
blockSplit CmmBlock
block
        collectLabels
          :: (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
          -> CmmNode O O
          -> (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
        collectLabels :: (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
-> CmmNode O O
-> (Map CLabel IpeSourceLocation, Maybe IpeSourceLocation)
collectLabels (!Map CLabel IpeSourceLocation
acc, Maybe IpeSourceLocation
lastTick) CmmNode O O
b =
          case (CmmNode O O
b, Maybe IpeSourceLocation
lastTick) of
            (CmmStore CmmExpr
_ (CmmLit (CmmLabel CLabel
l)) AlignmentSpec
_, Just IpeSourceLocation
src_loc) ->
              (CLabel
-> IpeSourceLocation
-> Map CLabel IpeSourceLocation
-> Map CLabel IpeSourceLocation
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CLabel
l IpeSourceLocation
src_loc Map CLabel IpeSourceLocation
acc, Maybe IpeSourceLocation
forall a. Maybe a
Nothing)
            (CmmTick (SourceNote RealSrcSpan
span String
name), Maybe IpeSourceLocation
_) ->
              (Map CLabel IpeSourceLocation
acc, IpeSourceLocation -> Maybe IpeSourceLocation
forall a. a -> Maybe a
Just (RealSrcSpan
span, String
name))
            (CmmNode O O, Maybe IpeSourceLocation)
_ -> (Map CLabel IpeSourceLocation
acc, Maybe IpeSourceLocation
lastTick)
labelsToSourcesSansTNTC Map CLabel IpeSourceLocation
acc GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
_ = Map CLabel IpeSourceLocation
acc