{-# LANGUAGE GADTs #-}

module GHC.Driver.GenerateCgIPEStub (generateCgIPEStub) where

import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes, listToMaybe)
import GHC.Cmm
import GHC.Cmm.CLabel (CLabel)
import GHC.Cmm.Dataflow (Block, C, O)
import GHC.Cmm.Dataflow.Block (blockSplit, blockToList)
import GHC.Cmm.Dataflow.Collections (mapToList)
import GHC.Cmm.Dataflow.Label (Label)
import GHC.Cmm.Info.Build (emptySRT)
import GHC.Cmm.Pipeline (cmmPipeline)
import GHC.Cmm.Utils (toBlockList)
import GHC.Data.Maybe (firstJusts)
import GHC.Data.Stream (Stream, liftIO)
import qualified GHC.Data.Stream as Stream
import GHC.Driver.Env (hsc_dflags)
import GHC.Driver.Env.Types (HscEnv)
import GHC.Driver.Flags (GeneralFlag (Opt_InfoTableMap))
import GHC.Driver.Session (gopt, targetPlatform)
import GHC.Driver.Config.StgToCmm
import GHC.Prelude
import GHC.Runtime.Heap.Layout (isStackRep)
import GHC.Settings (Platform, platformUnregisterised)
import GHC.StgToCmm.Monad (getCmm, initC, runC, initFCodeState)
import GHC.StgToCmm.Prof (initInfoTableProv)
import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos)
import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation)
import GHC.Types.Name.Set (NonCaffySet)
import GHC.Types.Tickish (GenTickish (SourceNote))
import GHC.Unit.Types (Module)
import GHC.Utils.Misc

{-
Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Stacktraces can be created from return frames as they are pushed to stack for every case scrutinee.
But to make them readable / meaningful, one needs to know the source location of each return frame.

Every return frame has a distinct info table and thus a distinct code pointer (for tables next to
code) or at least a distict address itself. Info Table Provernance Entries (IPE) are searchable by
this pointer and contain a source location.

The info table / info table code pointer to source location map is described in:
Note [Mapping Info Tables to Source Positions]

To be able to lookup IPEs for return frames one needs to emit them during compile time. This is done
by `generateCgIPEStub`.

This leads to the question: How to figure out the source location of a return frame?

While the lookup algorithms for registerised and unregisterised builds differ in details, they have in
common that we want to lookup the `CmmNode.CmmTick` (containing a `SourceNote`) that is nearest
(before) the usage of the return frame's label. (Which label and label type is used differs between
these two use cases.)

Registerised
~~~~~~~~~~~~~

Let's consider this example:
```
 Main.returnFrame_entry() { //  [R2]
         { info_tbls: [(c18g,
                        label: block_c18g_info
                        rep: StackRep []
                        srt: Just GHC.CString.unpackCString#_closure),
                       (c18r,
                        label: Main.returnFrame_info
                        rep: HeapRep static { Fun {arity: 1 fun_type: ArgSpec 5} }
                        srt: Nothing)]
           stack_info: arg_space: 8
         }
     {offset

      [...]

       c18u: // global
           //tick src<Main.hs:(7,1)-(16,15)>
           I64[Hp - 16] = sat_s16B_info;
           P64[Hp] = _s16r::P64;
           _c17j::P64 = Hp - 16;
           //tick src<Main.hs:8:25-39>
           I64[Sp - 8] = c18g;
           R3 = _c17j::P64;
           R2 = GHC.IO.Unsafe.unsafePerformIO_closure;
           R1 = GHC.Base.$_closure;
           Sp = Sp - 8;
           call stg_ap_pp_fast(R3,
                               R2,
                               R1) returns to c18g, args: 8, res: 8, upd: 8;
```

The return frame `block_c18g_info` has the label `c18g` which is used in the call to `stg_ap_pp_fast`
(`returns to c18g`) as continuation (`cml_cont`). The source location we're after, is the nearest
`//tick` before the call (`//tick src<Main.hs:8:25-39>`).

In code the Cmm program is represented as a Hoopl graph. Hoopl distinguishes nodes by defining if they
are open or closed on entry (one can fallthrough to them from the previous instruction) and if they are
open or closed on exit (one can fallthrough from them to the next node).

Please refer to the paper "Hoopl: A Modular, Reusable Library for Dataflow Analysis and Transformation"
for a detailed explanation.

Here we use the fact, that calls (represented by `CmmNode.CmmCall`) are always closed on exit
(`CmmNode O C`, `O` means open, `C` closed). In other words, they are always at the end of a block.

So, given a stack represented info table (likely representing a return frame, but this isn't completely
sure as there are e.g. update frames, too) with it's label (`c18g` in the example above) and a `CmmGraph`:
  - Look at the end of every block, if it's a `CmmNode.CmmCall` returning to the continuation with the
    label of the return frame.
  - If there's such a call, lookup the nearest `CmmNode.CmmTick` by traversing the middle part of the block
    backwards (from end to beginning).
  - Take the first `CmmNode.CmmTick` that contains a `Tickish.SourceNote` and return it's payload as
    `IpeSourceLocation`. (There are other `Tickish` constructors like `ProfNote` or `HpcTick`, these are
    ignored.)

Unregisterised
~~~~~~~~~~~~~

In unregisterised builds there is no return frame / continuation label in calls. The continuation (i.e. return
frame) is set in an explicit Cmm assignment. Thus the tick lookup algorithm has to be slightly different.

```
 sat_s16G_entry() { //  [R1]
         { info_tbls: [(c18O,
                        label: sat_s16G_info
                        rep: HeapRep { Thunk }
                        srt: Just _u18Z_srt)]
           stack_info: arg_space: 0
         }
     {offset
       c18O: // global
           _s16G::P64 = R1;
           if ((Sp + 8) - 40 < SpLim) (likely: False) goto c18P; else goto c18Q;
       c18P: // global
           R1 = _s16G::P64;
           call (stg_gc_enter_1)(R1) args: 8, res: 0, upd: 8;
       c18Q: // global
           I64[Sp - 16] = stg_upd_frame_info;
           P64[Sp - 8] = _s16G::P64;
           //tick src<Main.hs:20:9-13>
           I64[Sp - 24] = block_c18M_info;
           R1 = GHC.Show.$fShow[]_closure;
           P64[Sp - 32] = GHC.Show.$fShowChar_closure;
           Sp = Sp - 32;
           call stg_ap_p_fast(R1) args: 16, res: 8, upd: 24;
     }
 },
 _blk_c18M() { //  [R1]
         { info_tbls: [(c18M,
                        label: block_c18M_info
                        rep: StackRep []
                        srt: Just System.IO.print_closure)]
           stack_info: arg_space: 0
         }
     {offset
       c18M: // global
           _s16F::P64 = R1;
           R1 = System.IO.print_closure;
           P64[Sp] = _s16F::P64;
           call stg_ap_p_fast(R1) args: 32, res: 0, upd: 24;
     }
 },
```

In this example we have to lookup `//tick src<Main.hs:20:9-13>` for the return frame `c18M`.
Notice, that this cannot be done with the `Label` `c18M`, but with the `CLabel` `block_c18M_info`
(`label: block_c18M_info` is actually a `CLabel`).

The find the tick:
  - Every `Block` is checked from top (first) to bottom (last) node for an assignment like
   `I64[Sp - 24] = block_c18M_info;`. The lefthand side is actually ignored.
  - If such an assignment is found the search is over, because the payload (content of
    `Tickish.SourceNote`, represented as `IpeSourceLocation`) of last visited tick is always
    remembered in a `Maybe`.
-}

generateCgIPEStub :: HscEnv -> Module -> InfoTableProvMap -> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos) -> Stream IO CmmGroupSRTs CmmCgInfos
generateCgIPEStub :: HscEnv
-> Module
-> InfoTableProvMap
-> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos)
-> Stream IO CmmGroupSRTs CmmCgInfos
generateCgIPEStub HscEnv
hsc_env Module
this_mod InfoTableProvMap
denv Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos)
s = do
  let dflags :: DynFlags
dflags   = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
      platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
      fstate :: FCodeState
fstate   = Platform -> FCodeState
initFCodeState Platform
platform
  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

  -- Collect info tables, but only if -finfo-table-map is enabled, otherwise labeledInfoTablesWithTickishes is empty.
  let collectFun :: [(Label, CmmInfoTable, Maybe IpeSourceLocation)]
-> CmmGroupSRTs
-> IO
     ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs)
collectFun = if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_InfoTableMap DynFlags
dflags then Platform
-> [(Label, CmmInfoTable, Maybe IpeSourceLocation)]
-> CmmGroupSRTs
-> IO
     ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs)
collect Platform
platform else [(Label, CmmInfoTable, Maybe IpeSourceLocation)]
-> CmmGroupSRTs
-> IO
     ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs)
forall a. [a] -> CmmGroupSRTs -> IO ([a], CmmGroupSRTs)
collectNothing
  ([(Label, CmmInfoTable, Maybe IpeSourceLocation)]
labeledInfoTablesWithTickishes, (NonCaffySet
nonCaffySet, ModuleLFInfos
moduleLFInfos)) <- ([(Label, CmmInfoTable, Maybe IpeSourceLocation)]
 -> CmmGroupSRTs
 -> IO
      ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs))
-> [(Label, CmmInfoTable, Maybe IpeSourceLocation)]
-> Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos)
-> Stream
     IO
     CmmGroupSRTs
     ([(Label, CmmInfoTable, Maybe IpeSourceLocation)],
      (NonCaffySet, ModuleLFInfos))
forall (m :: * -> *) a b c r.
Monad m =>
(c -> a -> m (c, b)) -> c -> Stream m a r -> Stream m b (c, r)
Stream.mapAccumL_ [(Label, CmmInfoTable, Maybe IpeSourceLocation)]
-> CmmGroupSRTs
-> IO
     ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs)
collectFun [] Stream IO CmmGroupSRTs (NonCaffySet, ModuleLFInfos)
s

  -- Yield Cmm for Info Table Provenance Entries (IPEs)
  let denv' :: InfoTableProvMap
denv' = InfoTableProvMap
denv {provInfoTables :: InfoTableToSourceLocationMap
provInfoTables = [(CLabel, Maybe IpeSourceLocation)] -> InfoTableToSourceLocationMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (((Label, CmmInfoTable, Maybe IpeSourceLocation)
 -> (CLabel, Maybe IpeSourceLocation))
-> [(Label, CmmInfoTable, Maybe IpeSourceLocation)]
-> [(CLabel, Maybe IpeSourceLocation)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Label
_, CmmInfoTable
i, Maybe IpeSourceLocation
t) -> (CmmInfoTable -> CLabel
cit_lbl CmmInfoTable
i, Maybe IpeSourceLocation
t)) [(Label, CmmInfoTable, Maybe IpeSourceLocation)]
labeledInfoTablesWithTickishes)}
      ((CStub
ipeStub, CmmGroup
ipeCmmGroup), CgState
_) = StgToCmmConfig
-> FCodeState
-> CgState
-> FCode (CStub, CmmGroup)
-> ((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 (CStub, CmmGroup) -> ((CStub, CmmGroup), CgState))
-> FCode (CStub, CmmGroup) -> ((CStub, CmmGroup), CgState)
forall a b. (a -> b) -> a -> b
$ FCode CStub -> FCode (CStub, CmmGroup)
forall a. FCode a -> FCode (a, CmmGroup)
getCmm ([CmmInfoTable] -> InfoTableProvMap -> FCode CStub
initInfoTableProv (((Label, CmmInfoTable, Maybe IpeSourceLocation) -> CmmInfoTable)
-> [(Label, CmmInfoTable, Maybe IpeSourceLocation)]
-> [CmmInfoTable]
forall a b. (a -> b) -> [a] -> [b]
map (Label, CmmInfoTable, Maybe IpeSourceLocation) -> CmmInfoTable
forall a b c. (a, b, c) -> b
sndOf3 [(Label, CmmInfoTable, Maybe IpeSourceLocation)]
labeledInfoTablesWithTickishes) 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
$ HscEnv
-> ModuleSRTInfo -> CmmGroup -> IO (ModuleSRTInfo, CmmGroupSRTs)
cmmPipeline HscEnv
hsc_env (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

  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}
  where
    collect :: Platform -> [(Label, CmmInfoTable, Maybe IpeSourceLocation)] -> CmmGroupSRTs -> IO ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs)
    collect :: Platform
-> [(Label, CmmInfoTable, Maybe IpeSourceLocation)]
-> CmmGroupSRTs
-> IO
     ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs)
collect Platform
platform [(Label, CmmInfoTable, Maybe IpeSourceLocation)]
acc CmmGroupSRTs
cmmGroupSRTs = do
      let labelsToInfoTables :: [(Label, CmmInfoTable)]
labelsToInfoTables = CmmGroupSRTs -> [(Label, CmmInfoTable)]
collectInfoTables CmmGroupSRTs
cmmGroupSRTs
          labelsToInfoTablesToTickishes :: [(Label, CmmInfoTable, Maybe IpeSourceLocation)]
labelsToInfoTablesToTickishes = ((Label, CmmInfoTable)
 -> (Label, CmmInfoTable, Maybe IpeSourceLocation))
-> [(Label, CmmInfoTable)]
-> [(Label, CmmInfoTable, Maybe IpeSourceLocation)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Label
l, CmmInfoTable
i) -> (Label
l, CmmInfoTable
i, Platform
-> CmmGroupSRTs -> Label -> CmmInfoTable -> Maybe IpeSourceLocation
lookupEstimatedTick Platform
platform CmmGroupSRTs
cmmGroupSRTs Label
l CmmInfoTable
i)) [(Label, CmmInfoTable)]
labelsToInfoTables
      ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs)
-> IO
     ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Label, CmmInfoTable, Maybe IpeSourceLocation)]
acc [(Label, CmmInfoTable, Maybe IpeSourceLocation)]
-> [(Label, CmmInfoTable, Maybe IpeSourceLocation)]
-> [(Label, CmmInfoTable, Maybe IpeSourceLocation)]
forall a. [a] -> [a] -> [a]
++ [(Label, CmmInfoTable, Maybe IpeSourceLocation)]
labelsToInfoTablesToTickishes, CmmGroupSRTs
cmmGroupSRTs)

    collectNothing :: [a] -> CmmGroupSRTs -> IO ([a], CmmGroupSRTs)
    collectNothing :: forall a. [a] -> CmmGroupSRTs -> IO ([a], CmmGroupSRTs)
collectNothing [a]
_ CmmGroupSRTs
cmmGroupSRTs = ([a], CmmGroupSRTs) -> IO ([a], CmmGroupSRTs)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], CmmGroupSRTs
cmmGroupSRTs)

    collectInfoTables :: CmmGroupSRTs -> [(Label, CmmInfoTable)]
    collectInfoTables :: CmmGroupSRTs -> [(Label, CmmInfoTable)]
collectInfoTables CmmGroupSRTs
cmmGroup = [[(Label, CmmInfoTable)]] -> [(Label, CmmInfoTable)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Label, CmmInfoTable)]] -> [(Label, CmmInfoTable)])
-> [[(Label, CmmInfoTable)]] -> [(Label, CmmInfoTable)]
forall a b. (a -> b) -> a -> b
$ [Maybe [(Label, CmmInfoTable)]] -> [[(Label, CmmInfoTable)]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [(Label, CmmInfoTable)]] -> [[(Label, CmmInfoTable)]])
-> [Maybe [(Label, CmmInfoTable)]] -> [[(Label, CmmInfoTable)]]
forall a b. (a -> b) -> a -> b
$ (GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
 -> Maybe [(Label, CmmInfoTable)])
-> CmmGroupSRTs -> [Maybe [(Label, CmmInfoTable)]]
forall a b. (a -> b) -> [a] -> [b]
map GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> Maybe [(Label, CmmInfoTable)]
extractInfoTables CmmGroupSRTs
cmmGroup

    extractInfoTables :: GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph -> Maybe [(Label, CmmInfoTable)]
    extractInfoTables :: GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
-> Maybe [(Label, CmmInfoTable)]
extractInfoTables (CmmProc CmmTopInfo
h CLabel
_ [GlobalReg]
_ CmmGraph
_) = [(Label, CmmInfoTable)] -> Maybe [(Label, CmmInfoTable)]
forall a. a -> Maybe a
Just ([(Label, CmmInfoTable)] -> Maybe [(Label, CmmInfoTable)])
-> [(Label, CmmInfoTable)] -> Maybe [(Label, CmmInfoTable)]
forall a b. (a -> b) -> a -> b
$ LabelMap CmmInfoTable -> [(KeyOf LabelMap, CmmInfoTable)]
forall a. LabelMap a -> [(KeyOf LabelMap, a)]
forall (map :: * -> *) a. IsMap map => map a -> [(KeyOf map, a)]
mapToList (CmmTopInfo -> LabelMap CmmInfoTable
info_tbls CmmTopInfo
h)
    extractInfoTables GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
_ = Maybe [(Label, CmmInfoTable)]
forall a. Maybe a
Nothing

    lookupEstimatedTick :: Platform -> CmmGroupSRTs -> Label -> CmmInfoTable -> Maybe IpeSourceLocation
    lookupEstimatedTick :: Platform
-> CmmGroupSRTs -> Label -> CmmInfoTable -> Maybe IpeSourceLocation
lookupEstimatedTick Platform
platform CmmGroupSRTs
cmmGroup Label
infoTableLabel CmmInfoTable
infoTable = do
      -- All return frame info tables are stack represented, though not all stack represented info
      -- tables have to be return frames.
      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
infoTable
        then do
          let findFun :: Block CmmNode C C -> Maybe IpeSourceLocation
findFun =
                if Platform -> Bool
platformUnregisterised Platform
platform
                  then CLabel -> Block CmmNode C C -> Maybe IpeSourceLocation
findCmmTickishForForUnregistered (CmmInfoTable -> CLabel
cit_lbl CmmInfoTable
infoTable)
                  else Label -> Block CmmNode C C -> Maybe IpeSourceLocation
findCmmTickishForRegistered Label
infoTableLabel
              blocks :: [Block CmmNode C C]
blocks = (CmmGraph -> [Block CmmNode C C])
-> [CmmGraph] -> [Block CmmNode C C]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CmmGraph -> [Block CmmNode C C]
toBlockList (CmmGroupSRTs -> [CmmGraph]
graphs CmmGroupSRTs
cmmGroup)
          [Maybe IpeSourceLocation] -> Maybe IpeSourceLocation
forall (f :: * -> *) a. Foldable f => f (Maybe a) -> Maybe a
firstJusts ([Maybe IpeSourceLocation] -> Maybe IpeSourceLocation)
-> [Maybe IpeSourceLocation] -> Maybe IpeSourceLocation
forall a b. (a -> b) -> a -> b
$ (Block CmmNode C C -> Maybe IpeSourceLocation)
-> [Block CmmNode C C] -> [Maybe IpeSourceLocation]
forall a b. (a -> b) -> [a] -> [b]
map Block CmmNode C C -> Maybe IpeSourceLocation
findFun [Block CmmNode C C]
blocks
        else Maybe IpeSourceLocation
forall a. Maybe a
Nothing
    graphs :: CmmGroupSRTs -> [CmmGraph]
    graphs :: CmmGroupSRTs -> [CmmGraph]
graphs = ([CmmGraph]
 -> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph -> [CmmGraph])
-> [CmmGraph] -> CmmGroupSRTs -> [CmmGraph]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [CmmGraph]
-> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph -> [CmmGraph]
forall d h. [CmmGraph] -> GenCmmDecl d h CmmGraph -> [CmmGraph]
go []
      where
        go :: [CmmGraph] -> GenCmmDecl d h CmmGraph -> [CmmGraph]
        go :: forall d h. [CmmGraph] -> GenCmmDecl d h CmmGraph -> [CmmGraph]
go [CmmGraph]
acc (CmmProc h
_ CLabel
_ [GlobalReg]
_ CmmGraph
g) = CmmGraph
g CmmGraph -> [CmmGraph] -> [CmmGraph]
forall a. a -> [a] -> [a]
: [CmmGraph]
acc
        go [CmmGraph]
acc GenCmmDecl d h CmmGraph
_ = [CmmGraph]
acc

    findCmmTickishForRegistered :: Label -> Block CmmNode C C -> Maybe IpeSourceLocation
    findCmmTickishForRegistered :: Label -> Block CmmNode C C -> Maybe IpeSourceLocation
findCmmTickishForRegistered Label
label Block CmmNode C C
block = do
      let (CmmNode C O
_, Block CmmNode O O
middleBlock, CmmNode O C
endBlock) = Block CmmNode C C -> (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 Block CmmNode C C
block

      CmmNode O C -> Label -> Maybe ()
isCallWithReturnFrameLabel CmmNode O C
endBlock Label
label
      Block CmmNode O O -> Maybe IpeSourceLocation
lastTickInBlock Block CmmNode O O
middleBlock
      where
        isCallWithReturnFrameLabel :: CmmNode O C -> Label -> Maybe ()
        isCallWithReturnFrameLabel :: CmmNode O C -> Label -> Maybe ()
isCallWithReturnFrameLabel (CmmCall CmmExpr
_ (Just Label
l) [GlobalReg]
_ ByteOff
_ ByteOff
_ ByteOff
_) Label
clabel | Label
l Label -> Label -> Bool
forall a. Eq a => a -> a -> Bool
== Label
clabel = () -> Maybe ()
forall a. a -> Maybe a
Just ()
        isCallWithReturnFrameLabel CmmNode O C
_ Label
_ = Maybe ()
forall a. Maybe a
Nothing

        lastTickInBlock :: Block CmmNode O O -> Maybe IpeSourceLocation
lastTickInBlock Block CmmNode O O
block =
          [IpeSourceLocation] -> Maybe IpeSourceLocation
forall a. [a] -> Maybe a
listToMaybe ([IpeSourceLocation] -> Maybe IpeSourceLocation)
-> [IpeSourceLocation] -> Maybe IpeSourceLocation
forall a b. (a -> b) -> a -> b
$
            [Maybe IpeSourceLocation] -> [IpeSourceLocation]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe IpeSourceLocation] -> [IpeSourceLocation])
-> [Maybe IpeSourceLocation] -> [IpeSourceLocation]
forall a b. (a -> b) -> a -> b
$
              (CmmNode O O -> Maybe IpeSourceLocation)
-> [CmmNode O O] -> [Maybe IpeSourceLocation]
forall a b. (a -> b) -> [a] -> [b]
map CmmNode O O -> Maybe IpeSourceLocation
maybeTick ([CmmNode O O] -> [Maybe IpeSourceLocation])
-> [CmmNode O O] -> [Maybe IpeSourceLocation]
forall a b. (a -> b) -> a -> b
$ ([CmmNode O O] -> [CmmNode O O]
forall a. [a] -> [a]
reverse ([CmmNode O O] -> [CmmNode O O])
-> (Block CmmNode O O -> [CmmNode O O])
-> Block CmmNode O O
-> [CmmNode O O]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block CmmNode O O -> [CmmNode O O]
forall (n :: Extensibility -> Extensibility -> *).
Block n O O -> [n O O]
blockToList) Block CmmNode O O
block

        maybeTick :: CmmNode O O -> Maybe IpeSourceLocation
        maybeTick :: CmmNode O O -> Maybe IpeSourceLocation
maybeTick (CmmTick (SourceNote RealSrcSpan
span String
name)) = IpeSourceLocation -> Maybe IpeSourceLocation
forall a. a -> Maybe a
Just (RealSrcSpan
span, String
name)
        maybeTick CmmNode O O
_ = Maybe IpeSourceLocation
forall a. Maybe a
Nothing

    findCmmTickishForForUnregistered :: CLabel -> Block CmmNode C C -> Maybe IpeSourceLocation
    findCmmTickishForForUnregistered :: CLabel -> Block CmmNode C C -> Maybe IpeSourceLocation
findCmmTickishForForUnregistered CLabel
cLabel Block CmmNode C C
block = do
      let (CmmNode C O
_, Block CmmNode O O
middleBlock, CmmNode O C
_) = Block CmmNode C C -> (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 Block CmmNode C C
block
      CLabel
-> [CmmNode O O]
-> Maybe IpeSourceLocation
-> Maybe IpeSourceLocation
find CLabel
cLabel (Block CmmNode O O -> [CmmNode O O]
forall (n :: Extensibility -> Extensibility -> *).
Block n O O -> [n O O]
blockToList Block CmmNode O O
middleBlock) Maybe IpeSourceLocation
forall a. Maybe a
Nothing
      where
        find :: CLabel -> [CmmNode O O] -> Maybe IpeSourceLocation -> Maybe IpeSourceLocation
        find :: CLabel
-> [CmmNode O O]
-> Maybe IpeSourceLocation
-> Maybe IpeSourceLocation
find CLabel
label (CmmNode O O
b : [CmmNode O O]
blocks) Maybe IpeSourceLocation
lastTick = case CmmNode O O
b of
          (CmmStore CmmExpr
_ (CmmLit (CmmLabel CLabel
l)) AlignmentSpec
_) -> if CLabel
label CLabel -> CLabel -> Bool
forall a. Eq a => a -> a -> Bool
== CLabel
l then Maybe IpeSourceLocation
lastTick else CLabel
-> [CmmNode O O]
-> Maybe IpeSourceLocation
-> Maybe IpeSourceLocation
find CLabel
label [CmmNode O O]
blocks Maybe IpeSourceLocation
lastTick
          (CmmTick (SourceNote RealSrcSpan
span String
name)) -> CLabel
-> [CmmNode O O]
-> Maybe IpeSourceLocation
-> Maybe IpeSourceLocation
find CLabel
label [CmmNode O O]
blocks (Maybe IpeSourceLocation -> Maybe IpeSourceLocation)
-> Maybe IpeSourceLocation -> Maybe IpeSourceLocation
forall a b. (a -> b) -> a -> b
$ IpeSourceLocation -> Maybe IpeSourceLocation
forall a. a -> Maybe a
Just (RealSrcSpan
span, String
name)
          CmmNode O O
_ -> CLabel
-> [CmmNode O O]
-> Maybe IpeSourceLocation
-> Maybe IpeSourceLocation
find CLabel
label [CmmNode O O]
blocks Maybe IpeSourceLocation
lastTick
        find CLabel
_ [] Maybe IpeSourceLocation
_ = Maybe IpeSourceLocation
forall a. Maybe a
Nothing