{-# 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