{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
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.Label
import GHC.Cmm.Info.Build (emptySRT)
import GHC.Cmm.Pipeline (cmmPipeline)
import GHC.Data.Stream (liftIO, liftEff)
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.DynFlags (gopt, targetPlatform)
import GHC.Driver.Config.StgToCmm
import GHC.Driver.Config.Cmm ( initCmmConfig )
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.StgToCmm.CgUtils (CgStream)
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)
import GHC.Types.Unique.DSM
generateCgIPEStub
:: HscEnv
-> Module
-> InfoTableProvMap
-> ( NonCaffySet
, ModuleLFInfos
, Map CmmInfoTable (Maybe IpeSourceLocation)
, IPEStats
)
-> CgStream CmmGroupSRTs CmmCgInfos
generateCgIPEStub :: HscEnv
-> Module
-> InfoTableProvMap
-> (NonCaffySet, ModuleLFInfos,
Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> CgStream 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 <- IO CgState -> Stream (UniqDSMT IO) CmmGroupSRTs CgState
forall a. IO a -> Stream (UniqDSMT IO) CmmGroupSRTs a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO CgState
initC
(mIpeStub, ipeCmmGroup) <- liftEff $ UDSMT $ \DUniqSupply
dus -> do
let denv' :: InfoTableProvMap
denv' = InfoTableProvMap
denv {provInfoTables = Map.mapKeys cit_lbl infoTablesWithTickishes}
(((Maybe (IPEStats, CStub)
mIpeStub, DUniqSupply
dus'), DCmmGroup
ipeCmmGroup), CgState
_) =
StgToCmmConfig
-> FCodeState
-> CgState
-> FCode ((Maybe (IPEStats, CStub), DUniqSupply), DCmmGroup)
-> (((Maybe (IPEStats, CStub), DUniqSupply), DCmmGroup), 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), DUniqSupply), DCmmGroup)
-> (((Maybe (IPEStats, CStub), DUniqSupply), DCmmGroup), CgState))
-> FCode ((Maybe (IPEStats, CStub), DUniqSupply), DCmmGroup)
-> (((Maybe (IPEStats, CStub), DUniqSupply), DCmmGroup), CgState)
forall a b. (a -> b) -> a -> b
$
FCode (Maybe (IPEStats, CStub), DUniqSupply)
-> FCode ((Maybe (IPEStats, CStub), DUniqSupply), DCmmGroup)
forall a. FCode a -> FCode (a, DCmmGroup)
getCmm (IPEStats
-> [CmmInfoTable]
-> InfoTableProvMap
-> DUniqSupply
-> FCode (Maybe (IPEStats, CStub), DUniqSupply)
initInfoTableProv IPEStats
initStats (Map CmmInfoTable (Maybe IpeSourceLocation) -> [CmmInfoTable]
forall k a. Map k a -> [k]
Map.keys Map CmmInfoTable (Maybe IpeSourceLocation)
infoTablesWithTickishes) InfoTableProvMap
denv' DUniqSupply
dus)
((Maybe (IPEStats, CStub), DCmmGroup), DUniqSupply)
-> IO ((Maybe (IPEStats, CStub), DCmmGroup), DUniqSupply)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe (IPEStats, CStub)
mIpeStub, DCmmGroup
ipeCmmGroup), DUniqSupply
dus')
(_, ipeCmmGroupSRTs) <- liftEff $ withDUS $ cmmPipeline logger cmm_cfg (emptySRT this_mod) (removeDeterm ipeCmmGroup)
Stream.yield ipeCmmGroupSRTs
ipeStub <-
case mIpeStub of
Just (IPEStats
stats, CStub
stub) -> do
IO () -> Stream (UniqDSMT IO) CmmGroupSRTs ()
forall a. IO a -> Stream (UniqDSMT IO) CmmGroupSRTs a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Stream (UniqDSMT IO) CmmGroupSRTs ())
-> IO () -> Stream (UniqDSMT 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 (UniqDSMT IO) CmmGroupSRTs CStub
forall a. a -> Stream (UniqDSMT IO) CmmGroupSRTs a
forall (m :: * -> *) a. Monad m => a -> m a
return CStub
stub
Maybe (IPEStats, CStub)
Nothing -> CStub -> Stream (UniqDSMT IO) CmmGroupSRTs CStub
forall a. a -> Stream (UniqDSMT IO) CmmGroupSRTs a
forall (m :: * -> *) a. Monad m => a -> m a
return CStub
forall a. Monoid a => a
mempty
return CmmCgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = 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
_ [GlobalRegUse]
_ CmmGraph
_) =
((Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> Label
-> CmmInfoTable
-> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats))
-> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> LabelMap CmmInfoTable
-> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
forall t b. (t -> Label -> b -> t) -> t -> LabelMap b -> t
mapFoldlWithKey (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
-> Label
-> CmmInfoTable
-> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats)
go (Map CmmInfoTable (Maybe IpeSourceLocation)
acc, IPEStats
stats) (CmmTopInfo -> LabelMap CmmInfoTable
forall (f :: * -> *). GenCmmTopInfo f -> f 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
_ [GlobalRegUse]
_ 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) [GlobalRegUse]
_ 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 LexicalFastString
name)) Maybe IpeSourceLocation
Nothing = IpeSourceLocation -> Maybe IpeSourceLocation
forall a. a -> Maybe a
Just (RealSrcSpan
span, LexicalFastString
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
_ [GlobalRegUse]
_ 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 LexicalFastString
name), Maybe IpeSourceLocation
_) ->
(Map CLabel IpeSourceLocation
acc, IpeSourceLocation -> Maybe IpeSourceLocation
forall a. a -> Maybe a
Just (RealSrcSpan
span, LexicalFastString
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