    {-# LANGUAGE CPP #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE MultiWayIf #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# LANGUAGE LambdaCase #-}

    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

    -----------------------------------------------------------------------------
    --
    -- Debugging data
    --
    -- Association of debug data on the Cmm level, with methods to encode it in
    -- event log format for later inclusion in profiling event logs.
    --
    -----------------------------------------------------------------------------

    module GHC.Cmm.DebugBlock (

      DebugBlock(..),
      cmmDebugGen,
      cmmDebugLabels,
      cmmDebugLink,
      debugToMap,

      -- * Unwinding information
      UnwindTable, UnwindPoint(..),
      UnwindExpr(..), toUnwindExpr
      ) where

    import GHC.Prelude

    import GHC.Platform
    import GHC.Cmm.BlockId
    import GHC.Cmm.CLabel
    import GHC.Cmm
    import GHC.Cmm.Utils
    import GHC.Data.FastString ( nilFS, mkFastString )
    import GHC.Unit.Module
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Cmm.Ppr.Expr ( pprExpr )
    import GHC.Types.SrcLoc
    import GHC.Types.Tickish
    import GHC.Utils.Misc      ( seqList )

    import GHC.Cmm.Dataflow.Block
    import GHC.Cmm.Dataflow.Collections
    import GHC.Cmm.Dataflow.Graph
    import GHC.Cmm.Dataflow.Label

    import Data.Maybe
    import Data.List     ( minimumBy, nubBy )
    import Data.Ord      ( comparing )
    import qualified Data.Map as Map
    import Data.Either   ( partitionEithers )

    -- | Debug information about a block of code. Ticks scope over nested
    -- blocks.
    data DebugBlock =
      DebugBlock
      { DebugBlock -> Label
    dblProcedure  :: !Label        -- ^ Entry label of containing proc
      , DebugBlock -> Label
    dblLabel      :: !Label        -- ^ Hoopl label
      , DebugBlock -> CLabel
    dblCLabel     :: !CLabel       -- ^ Output label
      , DebugBlock -> Bool
    dblHasInfoTbl :: !Bool         -- ^ Has an info table?
      , DebugBlock -> Maybe DebugBlock
    dblParent     :: !(Maybe DebugBlock)
        -- ^ The parent of this proc. See Note [Splitting DebugBlocks]
      , DebugBlock -> [GenTickish 'TickishPassCmm]
    dblTicks      :: ![CmmTickish] -- ^ Ticks defined in this block
      , DebugBlock -> Maybe (GenTickish 'TickishPassCmm)
    dblSourceTick :: !(Maybe CmmTickish) -- ^ Best source tick covering block
      , DebugBlock -> Maybe Int
    dblPosition   :: !(Maybe Int)  -- ^ Output position relative to
                                       -- other blocks. @Nothing@ means
                                       -- the block was optimized out
      , DebugBlock -> [UnwindPoint]
    dblUnwind     :: [UnwindPoint]
      , DebugBlock -> [DebugBlock]
    dblBlocks     :: ![DebugBlock] -- ^ Nested blocks
      }

    instance OutputableP env CLabel => OutputableP env DebugBlock where
      pdoc :: env -> DebugBlock -> SDoc
    pdoc env
    env DebugBlock
    blk =
                (if | DebugBlock -> Label
    dblProcedure DebugBlock
    blk Label -> Label -> Bool
    forall a. Eq a => a -> a -> Bool
    == DebugBlock -> Label
    dblLabel DebugBlock
    blk
                    -> String -> SDoc
    text String
    "proc"
                    | DebugBlock -> Bool
    dblHasInfoTbl DebugBlock
    blk
                    -> String -> SDoc
    text String
    "pp-blk"
                    | Bool
    otherwise
                    -> String -> SDoc
    text String
    "blk") SDoc -> SDoc -> SDoc
    <+>
                Label -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (DebugBlock -> Label
    dblLabel DebugBlock
    blk) SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    parens (env -> CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc env
    env (DebugBlock -> CLabel
    dblCLabel DebugBlock
    blk)) SDoc -> SDoc -> SDoc
    <+>
                (SDoc
    -> (GenTickish 'TickishPassCmm -> SDoc)
    -> Maybe (GenTickish 'TickishPassCmm)
    -> SDoc
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe SDoc
    empty GenTickish 'TickishPassCmm -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (DebugBlock -> Maybe (GenTickish 'TickishPassCmm)
    dblSourceTick DebugBlock
    blk)) SDoc -> SDoc -> SDoc
    <+>
                (SDoc -> (Int -> SDoc) -> Maybe Int -> SDoc
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> SDoc
    text String
    "removed") ((String -> SDoc
    text String
    "pos " SDoc -> SDoc -> SDoc
    <>) (SDoc -> SDoc) -> (Int -> SDoc) -> Int -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr)
                       (DebugBlock -> Maybe Int
    dblPosition DebugBlock
    blk)) SDoc -> SDoc -> SDoc
    <+>
                (env -> [UnwindPoint] -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc env
    env (DebugBlock -> [UnwindPoint]
    dblUnwind DebugBlock
    blk)) SDoc -> SDoc -> SDoc
    $+$
                (if [DebugBlock] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (DebugBlock -> [DebugBlock]
    dblBlocks DebugBlock
    blk) then SDoc
    empty else Int -> SDoc -> SDoc
    nest Int
    4 (env -> [DebugBlock] -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc env
    env (DebugBlock -> [DebugBlock]
    dblBlocks DebugBlock
    blk)))

    -- | Intermediate data structure holding debug-relevant context information
    -- about a block.
    type BlockContext = (CmmBlock, RawCmmDecl)

    -- | Extract debug data from a group of procedures. We will prefer
    -- source notes that come from the given module (presumably the module
    -- that we are currently compiling).
    cmmDebugGen :: ModLocation -> RawCmmGroup -> [DebugBlock]
    cmmDebugGen :: ModLocation -> RawCmmGroup -> [DebugBlock]
    cmmDebugGen ModLocation
    modLoc RawCmmGroup
    decls = (CmmTickScope -> DebugBlock) -> [CmmTickScope] -> [DebugBlock]
    forall a b. (a -> b) -> [a] -> [b]
    map (Maybe (GenTickish 'TickishPassCmm) -> CmmTickScope -> DebugBlock
    blocksForScope Maybe (GenTickish 'TickishPassCmm)
    forall a. Maybe a
    Nothing) [CmmTickScope]
    topScopes
      where
          blockCtxs :: Map.Map CmmTickScope [BlockContext]
          blockCtxs :: Map CmmTickScope [BlockContext]
    blockCtxs = RawCmmGroup -> Map CmmTickScope [BlockContext]
    blockContexts RawCmmGroup
    decls

          -- Analyse tick scope structure: Each one is either a top-level
          -- tick scope, or the child of another.
          ([CmmTickScope]
    topScopes, [(CmmTickScope, CmmTickScope)]
    childScopes)
            = [Either CmmTickScope (CmmTickScope, CmmTickScope)]
    -> ([CmmTickScope], [(CmmTickScope, CmmTickScope)])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers ([Either CmmTickScope (CmmTickScope, CmmTickScope)]
     -> ([CmmTickScope], [(CmmTickScope, CmmTickScope)]))
    -> [Either CmmTickScope (CmmTickScope, CmmTickScope)]
    -> ([CmmTickScope], [(CmmTickScope, CmmTickScope)])
    forall a b. (a -> b) -> a -> b
    $ (CmmTickScope -> Either CmmTickScope (CmmTickScope, CmmTickScope))
    -> [CmmTickScope]
    -> [Either CmmTickScope (CmmTickScope, CmmTickScope)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\CmmTickScope
    a -> CmmTickScope
    -> CmmTickScope -> Either CmmTickScope (CmmTickScope, CmmTickScope)
    forall {t}. t -> CmmTickScope -> Either t (CmmTickScope, t)
    findP CmmTickScope
    a CmmTickScope
    a) ([CmmTickScope]
     -> [Either CmmTickScope (CmmTickScope, CmmTickScope)])
    -> [CmmTickScope]
    -> [Either CmmTickScope (CmmTickScope, CmmTickScope)]
    forall a b. (a -> b) -> a -> b
    $ Map CmmTickScope [BlockContext] -> [CmmTickScope]
    forall k a. Map k a -> [k]
    Map.keys Map CmmTickScope [BlockContext]
    blockCtxs
          findP :: t -> CmmTickScope -> Either t (CmmTickScope, t)
    findP t
    tsc CmmTickScope
    GlobalScope = t -> Either t (CmmTickScope, t)
    forall a b. a -> Either a b
    Left t
    tsc -- top scope
          findP t
    tsc CmmTickScope
    scp | CmmTickScope
    scp' CmmTickScope -> Map CmmTickScope [BlockContext] -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    `Map.member` Map CmmTickScope [BlockContext]
    blockCtxs = (CmmTickScope, t) -> Either t (CmmTickScope, t)
    forall a b. b -> Either a b
    Right (CmmTickScope
    scp', t
    tsc)
                        | Bool
    otherwise                   = t -> CmmTickScope -> Either t (CmmTickScope, t)
    findP t
    tsc CmmTickScope
    scp'
            where -- Note that we only following the left parent of
                  -- combined scopes. This loses us ticks, which we will
                  -- recover by copying ticks below.
                  scp' :: CmmTickScope
    scp' | SubScope Unique
    _ CmmTickScope
    scp' <- CmmTickScope
    scp      = CmmTickScope
    scp'
                       | CombinedScope CmmTickScope
    scp' CmmTickScope
    _ <- CmmTickScope
    scp = CmmTickScope
    scp'
    #if __GLASGOW_HASKELL__ < 901
                       | otherwise                   = panic "findP impossible"
    #endif

          scopeMap :: Map CmmTickScope [CmmTickScope]
    scopeMap = ((CmmTickScope, CmmTickScope)
     -> Map CmmTickScope [CmmTickScope]
     -> Map CmmTickScope [CmmTickScope])
    -> Map CmmTickScope [CmmTickScope]
    -> [(CmmTickScope, CmmTickScope)]
    -> Map CmmTickScope [CmmTickScope]
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((CmmTickScope
     -> CmmTickScope
     -> Map CmmTickScope [CmmTickScope]
     -> Map CmmTickScope [CmmTickScope])
    -> (CmmTickScope, CmmTickScope)
    -> Map CmmTickScope [CmmTickScope]
    -> Map CmmTickScope [CmmTickScope]
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry CmmTickScope
    -> CmmTickScope
    -> Map CmmTickScope [CmmTickScope]
    -> Map CmmTickScope [CmmTickScope]
    forall k a. Ord k => k -> a -> Map k [a] -> Map k [a]
    insertMulti) Map CmmTickScope [CmmTickScope]
    forall k a. Map k a
    Map.empty [(CmmTickScope, CmmTickScope)]
    childScopes

          -- This allows us to recover ticks that we lost by flattening
          -- the graph. Basically, if the parent is A but the child is
          -- CBA, we know that there is no BA, because it would have taken
          -- priority - but there might be a B scope, with ticks that
          -- would not be associated with our child anymore. Note however
          -- that there might be other childs (DB), which we have to
          -- filter out.
          --
          -- We expect this to be called rarely, which is why we are not
          -- trying too hard to be efficient here. In many cases we won't
          -- have to construct blockCtxsU in the first place.
          ticksToCopy :: CmmTickScope -> [CmmTickish]
          ticksToCopy :: CmmTickScope -> [GenTickish 'TickishPassCmm]
    ticksToCopy (CombinedScope CmmTickScope
    scp CmmTickScope
    s) = CmmTickScope -> [GenTickish 'TickishPassCmm]
    go CmmTickScope
    s
            where go :: CmmTickScope -> [GenTickish 'TickishPassCmm]
    go CmmTickScope
    s | CmmTickScope
    scp CmmTickScope -> CmmTickScope -> Bool
    `isTickSubScope` CmmTickScope
    s   = [] -- done
                       | SubScope Unique
    _ CmmTickScope
    s' <- CmmTickScope
    s       = [GenTickish 'TickishPassCmm]
    ticks [GenTickish 'TickishPassCmm]
    -> [GenTickish 'TickishPassCmm] -> [GenTickish 'TickishPassCmm]
    forall a. [a] -> [a] -> [a]
    ++ CmmTickScope -> [GenTickish 'TickishPassCmm]
    go CmmTickScope
    s'
                       | CombinedScope CmmTickScope
    s1 CmmTickScope
    s2 <- CmmTickScope
    s = [GenTickish 'TickishPassCmm]
    ticks [GenTickish 'TickishPassCmm]
    -> [GenTickish 'TickishPassCmm] -> [GenTickish 'TickishPassCmm]
    forall a. [a] -> [a] -> [a]
    ++ CmmTickScope -> [GenTickish 'TickishPassCmm]
    go CmmTickScope
    s1 [GenTickish 'TickishPassCmm]
    -> [GenTickish 'TickishPassCmm] -> [GenTickish 'TickishPassCmm]
    forall a. [a] -> [a] -> [a]
    ++ CmmTickScope -> [GenTickish 'TickishPassCmm]
    go CmmTickScope
    s2
                       | Bool
    otherwise                = String -> [GenTickish 'TickishPassCmm]
    forall a. String -> a
    panic String
    "ticksToCopy impossible"
                    where ticks :: [GenTickish 'TickishPassCmm]
    ticks = [BlockContext] -> [GenTickish 'TickishPassCmm]
    forall {b}.
    [(Block CmmNode C C, b)] -> [GenTickish 'TickishPassCmm]
    bCtxsTicks ([BlockContext] -> [GenTickish 'TickishPassCmm])
    -> [BlockContext] -> [GenTickish 'TickishPassCmm]
    forall a b. (a -> b) -> a -> b
    $ [BlockContext] -> Maybe [BlockContext] -> [BlockContext]
    forall a. a -> Maybe a -> a
    fromMaybe [] (Maybe [BlockContext] -> [BlockContext])
    -> Maybe [BlockContext] -> [BlockContext]
    forall a b. (a -> b) -> a -> b
    $ CmmTickScope
    -> Map CmmTickScope [BlockContext] -> Maybe [BlockContext]
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup CmmTickScope
    s Map CmmTickScope [BlockContext]
    blockCtxs
          ticksToCopy CmmTickScope
    _ = []
          bCtxsTicks :: [(Block CmmNode C C, b)] -> [GenTickish 'TickishPassCmm]
    bCtxsTicks = ((Block CmmNode C C, b) -> [GenTickish 'TickishPassCmm])
    -> [(Block CmmNode C C, b)] -> [GenTickish 'TickishPassCmm]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Block CmmNode C C -> [GenTickish 'TickishPassCmm]
    blockTicks (Block CmmNode C C -> [GenTickish 'TickishPassCmm])
    -> ((Block CmmNode C C, b) -> Block CmmNode C C)
    -> (Block CmmNode C C, b)
    -> [GenTickish 'TickishPassCmm]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Block CmmNode C C, b) -> Block CmmNode C C
    forall a b. (a, b) -> a
    fst)

          -- Finding the "best" source tick is somewhat arbitrary -- we
          -- select the first source span, while preferring source ticks
          -- from the same source file.  Furthermore, dumps take priority
          -- (if we generated one, we probably want debug information to
          -- refer to it).
          bestSrcTick :: [GenTickish 'TickishPassCmm] -> GenTickish 'TickishPassCmm
    bestSrcTick = (GenTickish 'TickishPassCmm
     -> GenTickish 'TickishPassCmm -> Ordering)
    -> [GenTickish 'TickishPassCmm] -> GenTickish 'TickishPassCmm
    forall (t :: * -> *) a.
    Foldable t =>
    (a -> a -> Ordering) -> t a -> a
    minimumBy ((GenTickish 'TickishPassCmm -> Int)
    -> GenTickish 'TickishPassCmm
    -> GenTickish 'TickishPassCmm
    -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing GenTickish 'TickishPassCmm -> Int
    rangeRating)
          rangeRating :: GenTickish 'TickishPassCmm -> Int
    rangeRating (SourceNote RealSrcSpan
    span String
    _)
            | RealSrcSpan -> FastString
    srcSpanFile RealSrcSpan
    span FastString -> FastString -> Bool
    forall a. Eq a => a -> a -> Bool
    == FastString
    thisFile = Int
    1
            | Bool
    otherwise                    = Int
    2 :: Int
          rangeRating GenTickish 'TickishPassCmm
    note                 = String -> SDoc -> Int
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "rangeRating" (GenTickish 'TickishPassCmm -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr GenTickish 'TickishPassCmm
    note)
          thisFile :: FastString
    thisFile = FastString -> (String -> FastString) -> Maybe String -> FastString
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe FastString
    nilFS String -> FastString
    mkFastString (Maybe String -> FastString) -> Maybe String -> FastString
    forall a b. (a -> b) -> a -> b
    $ ModLocation -> Maybe String
    ml_hs_file ModLocation
    modLoc

          -- Returns block tree for this scope as well as all nested
          -- scopes. Note that if there are multiple blocks in the (exact)
          -- same scope we elect one as the "branch" node and add the rest
          -- as children.
          blocksForScope :: Maybe CmmTickish -> CmmTickScope -> DebugBlock
          blocksForScope :: Maybe (GenTickish 'TickishPassCmm) -> CmmTickScope -> DebugBlock
    blocksForScope Maybe (GenTickish 'TickishPassCmm)
    cstick CmmTickScope
    scope = Bool -> BlockContext -> DebugBlock
    mkBlock Bool
    True ([BlockContext] -> BlockContext
    forall a. [a] -> a
    head [BlockContext]
    bctxs)
            where bctxs :: [BlockContext]
    bctxs = Maybe [BlockContext] -> [BlockContext]
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe [BlockContext] -> [BlockContext])
    -> Maybe [BlockContext] -> [BlockContext]
    forall a b. (a -> b) -> a -> b
    $ CmmTickScope
    -> Map CmmTickScope [BlockContext] -> Maybe [BlockContext]
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup CmmTickScope
    scope Map CmmTickScope [BlockContext]
    blockCtxs
                  nested :: [CmmTickScope]
    nested = [CmmTickScope] -> Maybe [CmmTickScope] -> [CmmTickScope]
    forall a. a -> Maybe a -> a
    fromMaybe [] (Maybe [CmmTickScope] -> [CmmTickScope])
    -> Maybe [CmmTickScope] -> [CmmTickScope]
    forall a b. (a -> b) -> a -> b
    $ CmmTickScope
    -> Map CmmTickScope [CmmTickScope] -> Maybe [CmmTickScope]
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup CmmTickScope
    scope Map CmmTickScope [CmmTickScope]
    scopeMap
                  childs :: [DebugBlock]
    childs = (BlockContext -> DebugBlock) -> [BlockContext] -> [DebugBlock]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool -> BlockContext -> DebugBlock
    mkBlock Bool
    False) ([BlockContext] -> [BlockContext]
    forall a. [a] -> [a]
    tail [BlockContext]
    bctxs) [DebugBlock] -> [DebugBlock] -> [DebugBlock]
    forall a. [a] -> [a] -> [a]
    ++
                           (CmmTickScope -> DebugBlock) -> [CmmTickScope] -> [DebugBlock]
    forall a b. (a -> b) -> [a] -> [b]
    map (Maybe (GenTickish 'TickishPassCmm) -> CmmTickScope -> DebugBlock
    blocksForScope Maybe (GenTickish 'TickishPassCmm)
    stick) [CmmTickScope]
    nested

                  mkBlock :: Bool -> BlockContext -> DebugBlock
                  mkBlock :: Bool -> BlockContext -> DebugBlock
    mkBlock Bool
    top (Block CmmNode C C
    block, RawCmmDecl
    prc)
                    = DebugBlock { dblProcedure :: Label
    dblProcedure    = GenCmmGraph CmmNode -> Label
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> Label
    g_entry GenCmmGraph CmmNode
    graph
                                 , dblLabel :: Label
    dblLabel        = Label
    label
                                 , dblCLabel :: CLabel
    dblCLabel       = case Maybe RawCmmStatics
    info of
                                     Just (CmmStaticsRaw CLabel
    infoLbl [CmmStatic]
    _) -> CLabel
    infoLbl
                                     Maybe RawCmmStatics
    Nothing
                                       | GenCmmGraph CmmNode -> Label
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> Label
    g_entry GenCmmGraph CmmNode
    graph Label -> Label -> Bool
    forall a. Eq a => a -> a -> Bool
    == Label
    label -> CLabel
    entryLbl
                                       | Bool
    otherwise              -> Label -> CLabel
    blockLbl Label
    label
                                 , dblHasInfoTbl :: Bool
    dblHasInfoTbl   = Maybe RawCmmStatics -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe RawCmmStatics
    info
                                 , dblParent :: Maybe DebugBlock
    dblParent       = Maybe DebugBlock
    forall a. Maybe a
    Nothing
                                 , dblTicks :: [GenTickish 'TickishPassCmm]
    dblTicks        = [GenTickish 'TickishPassCmm]
    ticks
                                 , dblPosition :: Maybe Int
    dblPosition     = Maybe Int
    forall a. Maybe a
    Nothing -- see cmmDebugLink
                                 , dblSourceTick :: Maybe (GenTickish 'TickishPassCmm)
    dblSourceTick   = Maybe (GenTickish 'TickishPassCmm)
    stick
                                 , dblBlocks :: [DebugBlock]
    dblBlocks       = [DebugBlock]
    blocks
                                 , dblUnwind :: [UnwindPoint]
    dblUnwind       = []
                                 }
                    where (CmmProc LabelMap RawCmmStatics
    infos CLabel
    entryLbl [GlobalReg]
    _ GenCmmGraph CmmNode
    graph) = RawCmmDecl
    prc
                          label :: Label
    label = Block CmmNode C C -> Label
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> Label
    entryLabel Block CmmNode C C
    block
                          info :: Maybe RawCmmStatics
    info = KeyOf LabelMap -> LabelMap RawCmmStatics -> Maybe RawCmmStatics
    forall (map :: * -> *) a.
    IsMap map =>
    KeyOf map -> map a -> Maybe a
    mapLookup KeyOf LabelMap
    Label
    label LabelMap RawCmmStatics
    infos
                          blocks :: [DebugBlock]
    blocks | Bool
    top       = [DebugBlock] -> [DebugBlock] -> [DebugBlock]
    forall a b. [a] -> b -> b
    seqList [DebugBlock]
    childs [DebugBlock]
    childs
                                 | Bool
    otherwise = []

                  -- A source tick scopes over all nested blocks. However
                  -- their source ticks might take priority.
                  isSourceTick :: GenTickish pass -> Bool
    isSourceTick SourceNote {} = Bool
    True
                  isSourceTick GenTickish pass
    _             = Bool
    False
                  -- Collect ticks from all blocks inside the tick scope.
                  -- We attempt to filter out duplicates while we're at it.
                  ticks :: [GenTickish 'TickishPassCmm]
    ticks = (GenTickish 'TickishPassCmm -> GenTickish 'TickishPassCmm -> Bool)
    -> [GenTickish 'TickishPassCmm] -> [GenTickish 'TickishPassCmm]
    forall a. (a -> a -> Bool) -> [a] -> [a]
    nubBy ((GenTickish 'TickishPassCmm -> GenTickish 'TickishPassCmm -> Bool)
    -> GenTickish 'TickishPassCmm -> GenTickish 'TickishPassCmm -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip GenTickish 'TickishPassCmm -> GenTickish 'TickishPassCmm -> Bool
    forall (pass :: TickishPass).
    Eq (GenTickish pass) =>
    GenTickish pass -> GenTickish pass -> Bool
    tickishContains) ([GenTickish 'TickishPassCmm] -> [GenTickish 'TickishPassCmm])
    -> [GenTickish 'TickishPassCmm] -> [GenTickish 'TickishPassCmm]
    forall a b. (a -> b) -> a -> b
    $
                          [BlockContext] -> [GenTickish 'TickishPassCmm]
    forall {b}.
    [(Block CmmNode C C, b)] -> [GenTickish 'TickishPassCmm]
    bCtxsTicks [BlockContext]
    bctxs [GenTickish 'TickishPassCmm]
    -> [GenTickish 'TickishPassCmm] -> [GenTickish 'TickishPassCmm]
    forall a. [a] -> [a] -> [a]
    ++ CmmTickScope -> [GenTickish 'TickishPassCmm]
    ticksToCopy CmmTickScope
    scope
                  stick :: Maybe (GenTickish 'TickishPassCmm)
    stick = case (GenTickish 'TickishPassCmm -> Bool)
    -> [GenTickish 'TickishPassCmm] -> [GenTickish 'TickishPassCmm]
    forall a. (a -> Bool) -> [a] -> [a]
    filter GenTickish 'TickishPassCmm -> Bool
    forall {pass :: TickishPass}. GenTickish pass -> Bool
    isSourceTick [GenTickish 'TickishPassCmm]
    ticks of
                    []     -> Maybe (GenTickish 'TickishPassCmm)
    cstick
                    [GenTickish 'TickishPassCmm]
    sticks -> GenTickish 'TickishPassCmm -> Maybe (GenTickish 'TickishPassCmm)
    forall a. a -> Maybe a
    Just (GenTickish 'TickishPassCmm -> Maybe (GenTickish 'TickishPassCmm))
    -> GenTickish 'TickishPassCmm -> Maybe (GenTickish 'TickishPassCmm)
    forall a b. (a -> b) -> a -> b
    $! [GenTickish 'TickishPassCmm] -> GenTickish 'TickishPassCmm
    bestSrcTick ([GenTickish 'TickishPassCmm]
    sticks [GenTickish 'TickishPassCmm]
    -> [GenTickish 'TickishPassCmm] -> [GenTickish 'TickishPassCmm]
    forall a. [a] -> [a] -> [a]
    ++ Maybe (GenTickish 'TickishPassCmm) -> [GenTickish 'TickishPassCmm]
    forall a. Maybe a -> [a]
    maybeToList Maybe (GenTickish 'TickishPassCmm)
    cstick)

    -- | Build a map of blocks sorted by their tick scopes
    --
    -- This involves a pre-order traversal, as we want blocks in rough
    -- control flow order (so ticks have a chance to be sorted in the
    -- right order).
    blockContexts :: RawCmmGroup -> Map.Map CmmTickScope [BlockContext]
    blockContexts :: RawCmmGroup -> Map CmmTickScope [BlockContext]
    blockContexts RawCmmGroup
    decls = ([BlockContext] -> [BlockContext])
    -> Map CmmTickScope [BlockContext]
    -> Map CmmTickScope [BlockContext]
    forall a b k. (a -> b) -> Map k a -> Map k b
    Map.map [BlockContext] -> [BlockContext]
    forall a. [a] -> [a]
    reverse (Map CmmTickScope [BlockContext]
     -> Map CmmTickScope [BlockContext])
    -> Map CmmTickScope [BlockContext]
    -> Map CmmTickScope [BlockContext]
    forall a b. (a -> b) -> a -> b
    $ (RawCmmDecl
     -> Map CmmTickScope [BlockContext]
     -> Map CmmTickScope [BlockContext])
    -> Map CmmTickScope [BlockContext]
    -> RawCmmGroup
    -> Map CmmTickScope [BlockContext]
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr RawCmmDecl
    -> Map CmmTickScope [BlockContext]
    -> Map CmmTickScope [BlockContext]
    walkProc Map CmmTickScope [BlockContext]
    forall k a. Map k a
    Map.empty RawCmmGroup
    decls
      where walkProc :: RawCmmDecl
                     -> Map.Map CmmTickScope [BlockContext]
                     -> Map.Map CmmTickScope [BlockContext]
            walkProc :: RawCmmDecl
    -> Map CmmTickScope [BlockContext]
    -> Map CmmTickScope [BlockContext]
    walkProc CmmData{}                 Map CmmTickScope [BlockContext]
    m = Map CmmTickScope [BlockContext]
    m
            walkProc prc :: RawCmmDecl
    prc@(CmmProc LabelMap RawCmmStatics
    _ CLabel
    _ [GlobalReg]
    _ GenCmmGraph CmmNode
    graph) Map CmmTickScope [BlockContext]
    m
              | LabelMap (Block CmmNode C C) -> Bool
    forall (map :: * -> *) a. IsMap map => map a -> Bool
    mapNull LabelMap (Block CmmNode C C)
    blocks = Map CmmTickScope [BlockContext]
    m
              | Bool
    otherwise      = (LabelSet, Map CmmTickScope [BlockContext])
    -> Map CmmTickScope [BlockContext]
    forall a b. (a, b) -> b
    snd ((LabelSet, Map CmmTickScope [BlockContext])
     -> Map CmmTickScope [BlockContext])
    -> (LabelSet, Map CmmTickScope [BlockContext])
    -> Map CmmTickScope [BlockContext]
    forall a b. (a -> b) -> a -> b
    $ RawCmmDecl
    -> [Block CmmNode C C]
    -> (LabelSet, Map CmmTickScope [BlockContext])
    -> (LabelSet, Map CmmTickScope [BlockContext])
    walkBlock RawCmmDecl
    prc [Block CmmNode C C]
    entry (LabelSet
    emptyLbls, Map CmmTickScope [BlockContext]
    m)
              where blocks :: LabelMap (Block CmmNode C C)
    blocks = GenCmmGraph CmmNode -> LabelMap (Block CmmNode C C)
    toBlockMap GenCmmGraph CmmNode
    graph
                    entry :: [Block CmmNode C C]
    entry  = [KeyOf LabelMap -> LabelMap (Block CmmNode C C) -> Block CmmNode C C
    forall {a}. KeyOf LabelMap -> LabelMap a -> a
    mapFind (GenCmmGraph CmmNode -> Label
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> Label
    g_entry GenCmmGraph CmmNode
    graph) LabelMap (Block CmmNode C C)
    blocks]
                    emptyLbls :: LabelSet
    emptyLbls = LabelSet
    forall set. IsSet set => set
    setEmpty :: LabelSet

            walkBlock :: RawCmmDecl -> [Block CmmNode C C]
                      -> (LabelSet, Map.Map CmmTickScope [BlockContext])
                      -> (LabelSet, Map.Map CmmTickScope [BlockContext])
            walkBlock :: RawCmmDecl
    -> [Block CmmNode C C]
    -> (LabelSet, Map CmmTickScope [BlockContext])
    -> (LabelSet, Map CmmTickScope [BlockContext])
    walkBlock RawCmmDecl
    _   []             (LabelSet, Map CmmTickScope [BlockContext])
    c            = (LabelSet, Map CmmTickScope [BlockContext])
    c
            walkBlock RawCmmDecl
    prc (Block CmmNode C C
    block:[Block CmmNode C C]
    blocks) (LabelSet
    visited, Map CmmTickScope [BlockContext]
    m)
              | ElemOf LabelSet
    Label
    lbl ElemOf LabelSet -> LabelSet -> Bool
    forall set. IsSet set => ElemOf set -> set -> Bool
    `setMember` LabelSet
    visited
              = RawCmmDecl
    -> [Block CmmNode C C]
    -> (LabelSet, Map CmmTickScope [BlockContext])
    -> (LabelSet, Map CmmTickScope [BlockContext])
    walkBlock RawCmmDecl
    prc [Block CmmNode C C]
    blocks (LabelSet
    visited, Map CmmTickScope [BlockContext]
    m)
              | Bool
    otherwise
              = RawCmmDecl
    -> [Block CmmNode C C]
    -> (LabelSet, Map CmmTickScope [BlockContext])
    -> (LabelSet, Map CmmTickScope [BlockContext])
    walkBlock RawCmmDecl
    prc [Block CmmNode C C]
    blocks ((LabelSet, Map CmmTickScope [BlockContext])
     -> (LabelSet, Map CmmTickScope [BlockContext]))
    -> (LabelSet, Map CmmTickScope [BlockContext])
    -> (LabelSet, Map CmmTickScope [BlockContext])
    forall a b. (a -> b) -> a -> b
    $
                RawCmmDecl
    -> [Block CmmNode C C]
    -> (LabelSet, Map CmmTickScope [BlockContext])
    -> (LabelSet, Map CmmTickScope [BlockContext])
    walkBlock RawCmmDecl
    prc [Block CmmNode C C]
    succs
                  (ElemOf LabelSet
    Label
    lbl ElemOf LabelSet -> LabelSet -> LabelSet
    forall set. IsSet set => ElemOf set -> set -> set
    `setInsert` LabelSet
    visited,
                   CmmTickScope
    -> BlockContext
    -> Map CmmTickScope [BlockContext]
    -> Map CmmTickScope [BlockContext]
    forall k a. Ord k => k -> a -> Map k [a] -> Map k [a]
    insertMulti CmmTickScope
    scope (Block CmmNode C C
    block, RawCmmDecl
    prc) Map CmmTickScope [BlockContext]
    m)
              where CmmEntry Label
    lbl CmmTickScope
    scope = Block CmmNode C C -> CmmNode C O
    forall (n :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    Block n C x -> n C O
    firstNode Block CmmNode C C
    block
                    (CmmProc LabelMap RawCmmStatics
    _ CLabel
    _ [GlobalReg]
    _ GenCmmGraph CmmNode
    graph) = RawCmmDecl
    prc
                    succs :: [Block CmmNode C C]
    succs = (Label -> Block CmmNode C C) -> [Label] -> [Block CmmNode C C]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Label -> LabelMap (Block CmmNode C C) -> Block CmmNode C C)
    -> LabelMap (Block CmmNode C C) -> Label -> Block CmmNode C C
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Label -> LabelMap (Block CmmNode C C) -> Block CmmNode C C
    forall {a}. KeyOf LabelMap -> LabelMap a -> a
    mapFind (GenCmmGraph CmmNode -> LabelMap (Block CmmNode C C)
    toBlockMap GenCmmGraph CmmNode
    graph))
                                (CmmNode O C -> [Label]
    forall (thing :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    NonLocal thing =>
    thing e C -> [Label]
    successors (Block CmmNode C C -> CmmNode O C
    forall (n :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    Block n x C -> n O C
    lastNode Block CmmNode C C
    block))
            mapFind :: KeyOf LabelMap -> LabelMap a -> a
    mapFind = a -> KeyOf LabelMap -> LabelMap a -> a
    forall (map :: * -> *) a. IsMap map => a -> KeyOf map -> map a -> a
    mapFindWithDefault (String -> a
    forall a. HasCallStack => String -> a
    error String
    "contextTree: block not found!")

    insertMulti :: Ord k => k -> a -> Map.Map k [a] -> Map.Map k [a]
    insertMulti :: forall k a. Ord k => k -> a -> Map k [a] -> Map k [a]
    insertMulti k
    k a
    v = ([a] -> [a] -> [a]) -> k -> [a] -> Map k [a] -> Map k [a]
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    Map.insertWith (([a] -> [a]) -> [a] -> [a] -> [a]
    forall a b. a -> b -> a
    const (a
    va -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :)) k
    k [a
    v]

    cmmDebugLabels :: (i -> Bool) -> GenCmmGroup d g (ListGraph i) -> [Label]
    cmmDebugLabels :: forall i d g.
    (i -> Bool) -> GenCmmGroup d g (ListGraph i) -> [Label]
    cmmDebugLabels i -> Bool
    isMeta GenCmmGroup d g (ListGraph i)
    nats = [Label] -> [Label] -> [Label]
    forall a b. [a] -> b -> b
    seqList [Label]
    lbls [Label]
    lbls
      where -- Find order in which procedures will be generated by the
            -- back-end (that actually matters for DWARF generation).
            --
            -- Note that we might encounter blocks that are missing or only
            -- consist of meta instructions -- we will declare them missing,
            -- which will skip debug data generation without messing up the
            -- block hierarchy.
            lbls :: [Label]
    lbls = (GenBasicBlock i -> Label) -> [GenBasicBlock i] -> [Label]
    forall a b. (a -> b) -> [a] -> [b]
    map GenBasicBlock i -> Label
    forall i. GenBasicBlock i -> Label
    blockId ([GenBasicBlock i] -> [Label]) -> [GenBasicBlock i] -> [Label]
    forall a b. (a -> b) -> a -> b
    $ (GenBasicBlock i -> Bool) -> [GenBasicBlock i] -> [GenBasicBlock i]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> (GenBasicBlock i -> Bool) -> GenBasicBlock i -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenBasicBlock i -> Bool
    allMeta) ([GenBasicBlock i] -> [GenBasicBlock i])
    -> [GenBasicBlock i] -> [GenBasicBlock i]
    forall a b. (a -> b) -> a -> b
    $ (GenCmmDecl d g (ListGraph i) -> [GenBasicBlock i])
    -> GenCmmGroup d g (ListGraph i) -> [GenBasicBlock i]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap GenCmmDecl d g (ListGraph i) -> [GenBasicBlock i]
    forall {d} {h} {i}.
    GenCmmDecl d h (ListGraph i) -> [GenBasicBlock i]
    getBlocks GenCmmGroup d g (ListGraph i)
    nats
            getBlocks :: GenCmmDecl d h (ListGraph i) -> [GenBasicBlock i]
    getBlocks (CmmProc h
    _ CLabel
    _ [GlobalReg]
    _ (ListGraph [GenBasicBlock i]
    bs)) = [GenBasicBlock i]
    bs
            getBlocks GenCmmDecl d h (ListGraph i)
    _other                         = []
            allMeta :: GenBasicBlock i -> Bool
    allMeta (BasicBlock Label
    _ [i]
    instrs) = (i -> Bool) -> [i] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all i -> Bool
    isMeta [i]
    instrs

    -- | Sets position and unwind table fields in the debug block tree according to
    -- native generated code.
    cmmDebugLink :: [Label] -> LabelMap [UnwindPoint]
                 -> [DebugBlock] -> [DebugBlock]
    cmmDebugLink :: [Label] -> LabelMap [UnwindPoint] -> [DebugBlock] -> [DebugBlock]
    cmmDebugLink [Label]
    labels LabelMap [UnwindPoint]
    unwindPts [DebugBlock]
    blocks = (DebugBlock -> DebugBlock) -> [DebugBlock] -> [DebugBlock]
    forall a b. (a -> b) -> [a] -> [b]
    map DebugBlock -> DebugBlock
    link [DebugBlock]
    blocks
      where blockPos :: LabelMap Int
            blockPos :: LabelMap Int
    blockPos = [(KeyOf LabelMap, Int)] -> LabelMap Int
    forall (map :: * -> *) a. IsMap map => [(KeyOf map, a)] -> map a
    mapFromList ([(KeyOf LabelMap, Int)] -> LabelMap Int)
    -> [(KeyOf LabelMap, Int)] -> LabelMap Int
    forall a b. (a -> b) -> a -> b
    $ ([Label] -> [Int] -> [(Label, Int)])
    -> [Int] -> [Label] -> [(Label, Int)]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip [Label] -> [Int] -> [(Label, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] [Label]
    labels
            link :: DebugBlock -> DebugBlock
    link DebugBlock
    block = DebugBlock
    block { dblPosition :: Maybe Int
    dblPosition = KeyOf LabelMap -> LabelMap Int -> Maybe Int
    forall (map :: * -> *) a.
    IsMap map =>
    KeyOf map -> map a -> Maybe a
    mapLookup (DebugBlock -> Label
    dblLabel DebugBlock
    block) LabelMap Int
    blockPos
                               , dblBlocks :: [DebugBlock]
    dblBlocks   = (DebugBlock -> DebugBlock) -> [DebugBlock] -> [DebugBlock]
    forall a b. (a -> b) -> [a] -> [b]
    map DebugBlock -> DebugBlock
    link (DebugBlock -> [DebugBlock]
    dblBlocks DebugBlock
    block)
                               , dblUnwind :: [UnwindPoint]
    dblUnwind   = [UnwindPoint] -> Maybe [UnwindPoint] -> [UnwindPoint]
    forall a. a -> Maybe a -> a
    fromMaybe [UnwindPoint]
    forall a. Monoid a => a
    mempty
                                             (Maybe [UnwindPoint] -> [UnwindPoint])
    -> Maybe [UnwindPoint] -> [UnwindPoint]
    forall a b. (a -> b) -> a -> b
    $ KeyOf LabelMap -> LabelMap [UnwindPoint] -> Maybe [UnwindPoint]
    forall (map :: * -> *) a.
    IsMap map =>
    KeyOf map -> map a -> Maybe a
    mapLookup (DebugBlock -> Label
    dblLabel DebugBlock
    block) LabelMap [UnwindPoint]
    unwindPts
                               }

    -- | Converts debug blocks into a label map for easier lookups
    debugToMap :: [DebugBlock] -> LabelMap DebugBlock
    debugToMap :: [DebugBlock] -> LabelMap DebugBlock
    debugToMap = [LabelMap DebugBlock] -> LabelMap DebugBlock
    forall (map :: * -> *) a. IsMap map => [map a] -> map a
    mapUnions ([LabelMap DebugBlock] -> LabelMap DebugBlock)
    -> ([DebugBlock] -> [LabelMap DebugBlock])
    -> [DebugBlock]
    -> LabelMap DebugBlock
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DebugBlock -> LabelMap DebugBlock)
    -> [DebugBlock] -> [LabelMap DebugBlock]
    forall a b. (a -> b) -> [a] -> [b]
    map DebugBlock -> LabelMap DebugBlock
    forall {map :: * -> *}.
    (KeyOf map ~ Label, IsMap map) =>
    DebugBlock -> map DebugBlock
    go
       where go :: DebugBlock -> map DebugBlock
    go DebugBlock
    b = KeyOf map -> DebugBlock -> map DebugBlock -> map DebugBlock
    forall (map :: * -> *) a.
    IsMap map =>
    KeyOf map -> a -> map a -> map a
    mapInsert (DebugBlock -> Label
    dblLabel DebugBlock
    b) DebugBlock
    b (map DebugBlock -> map DebugBlock)
    -> map DebugBlock -> map DebugBlock
    forall a b. (a -> b) -> a -> b
    $ [map DebugBlock] -> map DebugBlock
    forall (map :: * -> *) a. IsMap map => [map a] -> map a
    mapUnions ([map DebugBlock] -> map DebugBlock)
    -> [map DebugBlock] -> map DebugBlock
    forall a b. (a -> b) -> a -> b
    $ (DebugBlock -> map DebugBlock) -> [DebugBlock] -> [map DebugBlock]
    forall a b. (a -> b) -> [a] -> [b]
    map DebugBlock -> map DebugBlock
    go (DebugBlock -> [DebugBlock]
    dblBlocks DebugBlock
    b)

    {-
    Note [What is this unwinding business?]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    Unwinding tables are a variety of debugging information used by debugging tools
    to reconstruct the execution history of a program at runtime. These tables
    consist of sets of "instructions", one set for every instruction in the program,
    which describe how to reconstruct the state of the machine at the point where
    the current procedure was called. For instance, consider the following annotated
    pseudo-code,

      a_fun:
        add rsp, 8            -- unwind: rsp = rsp - 8
        mov rax, 1            -- unwind: rax = unknown
        call another_block
        sub rsp, 8            -- unwind: rsp = rsp

    We see that attached to each instruction there is an "unwind" annotation, which
    provides a relationship between each updated register and its value at the
    time of entry to a_fun. This is the sort of information that allows gdb to give
    you a stack backtrace given the execution state of your program. This
    unwinding information is captured in various ways by various debug information
    formats; in the case of DWARF (the only format supported by GHC) it is known as
    Call Frame Information (CFI) and can be found in the .debug.frames section of
    your object files.

    Currently we only bother to produce unwinding information for registers which
    are necessary to reconstruct flow-of-execution. On x86_64 this includes $rbp
    (which is the STG stack pointer) and $rsp (the C stack pointer).

    Let's consider how GHC would annotate a C-- program with unwinding information
    with a typical C-- procedure as would come from the STG-to-Cmm code generator,

      entry()
         { c2fe:
               v :: P64 = R2;
               if ((Sp + 8) - 32 < SpLim) (likely: False) goto c2ff; else goto c2fg;
           c2ff:
               R2 = v :: P64;
               R1 = test_closure;
               call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8;
           c2fg:
               I64[Sp - 8] = c2dD;
               R1 = v :: P64;
               Sp = Sp - 8;          // Sp updated here
               if (R1 & 7 != 0) goto c2dD; else goto c2dE;
           c2dE:
               call (I64[R1])(R1) returns to c2dD, args: 8, res: 8, upd: 8;
           c2dD:
               w :: P64 = R1;
               Hp = Hp + 48;
               if (Hp > HpLim) (likely: False) goto c2fj; else goto c2fi;
           ...
      },

    Let's consider how this procedure will be decorated with unwind information
    (largely by GHC.Cmm.LayoutStack). Naturally, when we enter the procedure `entry` the
    value of Sp is no different from what it was at its call site. Therefore we will
    add an `unwind` statement saying this at the beginning of its unwind-annotated
    code,

      entry()
         { c2fe:
               unwind Sp = Just Sp + 0;
               v :: P64 = R2;
               if ((Sp + 8) - 32 < SpLim) (likely: False) goto c2ff; else goto c2fg;

    After c2fe we may pass to either c2ff or c2fg; let's first consider the
    former. In this case there is nothing in particular that we need to do other
    than reiterate what we already know about Sp,

           c2ff:
               unwind Sp = Just Sp + 0;
               R2 = v :: P64;
               R1 = test_closure;
               call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8;

    In contrast, c2fg updates Sp midway through its body. To ensure that unwinding
    can happen correctly after this point we must include an unwind statement there,
    in addition to the usual beginning-of-block statement,

           c2fg:
               unwind Sp = Just Sp + 0;
               I64[Sp - 8] = c2dD;
               R1 = v :: P64;
               Sp = Sp - 8;
               unwind Sp = Just Sp + 8;
               if (R1 & 7 != 0) goto c2dD; else goto c2dE;

    The remaining blocks are simple,

           c2dE:
               unwind Sp = Just Sp + 8;
               call (I64[R1])(R1) returns to c2dD, args: 8, res: 8, upd: 8;
           c2dD:
               unwind Sp = Just Sp + 8;
               w :: P64 = R1;
               Hp = Hp + 48;
               if (Hp > HpLim) (likely: False) goto c2fj; else goto c2fi;
           ...
      },

    The flow of unwinding information through the compiler is a bit convoluted:

     * C-- begins life in StgToCmm without any unwind information. This is because we
       haven't actually done any register assignment or stack layout yet, so there
       is no need for unwind information.

     * GHC.Cmm.LayoutStack figures out how to layout each procedure's stack, and produces
       appropriate unwinding nodes for each adjustment of the STG Sp register.

     * The unwind nodes are carried through the sinking pass. Currently this is
       guaranteed not to invalidate unwind information since it won't touch stores
       to Sp, but this will need revisiting if CmmSink gets smarter in the future.

     * Eventually we make it to the native code generator backend which can then
       preserve the unwind nodes in its machine-specific instructions. In so doing
       the backend can also modify or add unwinding information; this is necessary,
       for instance, in the case of x86-64, where adjustment of $rsp may be
       necessary during calls to native foreign code due to the native calling
       convention.

     * The NCG then retrieves the final unwinding table for each block from the
       backend with extractUnwindPoints.

     * This unwind information is converted to DebugBlocks by Debug.cmmDebugGen

     * These DebugBlocks are then converted to, e.g., DWARF unwinding tables
       (by the Dwarf module) and emitted in the final object.

    See also:
      Note [Unwinding information in the NCG] in "GHC.CmmToAsm",
      Note [Unwind pseudo-instruction in Cmm],
      Note [Debugging DWARF unwinding info].

    Note [Debugging DWARF unwinding info]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    For debugging generated unwinding info I've found it most useful to dump the
    disassembled binary with objdump -D and dump the debug info with
    readelf --debug-dump=frames-interp.

    You should get something like this:

      0000000000000010 <stg_catch_frame_info>:
        10:   48 83 c5 18             add    $0x18,%rbp
        14:   ff 65 00                jmpq   *0x0(%rbp)

    and:

      Contents of the .debug_frame section:

      00000000 0000000000000014 ffffffff CIE "" cf=1 df=-8 ra=16
         LOC           CFA      rbp   rsp   ra
      0000000000000000 rbp+0    v+0   s     c+0

      00000018 0000000000000024 00000000 FDE cie=00000000 pc=000000000000000f..0000000000000017
         LOC           CFA      rbp   rsp   ra
      000000000000000f rbp+0    v+0   s     c+0
      000000000000000f rbp+24   v+0   s     c+0

    To read it http://www.dwarfstd.org/doc/dwarf-2.0.0.pdf has a nice example in
    Appendix 5 (page 101 of the pdf) and more details in the relevant section.

    The key thing to keep in mind is that the value at LOC is the value from
    *before* the instruction at LOC executes. In other words it answers the
    question: if my $rip is at LOC, how do I get the relevant values given the
    values obtained through unwinding so far.

    If the readelf --debug-dump=frames-interp output looks wrong, it may also be
    useful to look at readelf --debug-dump=frames, which is closer to the
    information that GHC generated.

    It's also useful to dump the relevant Cmm with -ddump-cmm -ddump-opt-cmm
    -ddump-cmm-proc -ddump-cmm-verbose. Note [Unwind pseudo-instruction in Cmm]
    explains how to interpret it.

    Inside gdb there are a couple useful commands for inspecting frames.
    For example:

      gdb> info frame <num>

    It shows the values of registers obtained through unwinding.

    Another useful thing to try when debugging the DWARF unwinding is to enable
    extra debugging output in GDB:

      gdb> set debug frame 1

    This makes GDB produce a trace of its internal workings. Having gone this far,
    it's just a tiny step to run GDB in GDB. Make sure you install debugging
    symbols for gdb if you obtain it through a package manager.

    Keep in mind that the current release of GDB has an instruction pointer handling
    heuristic that works well for C-like languages, but doesn't always work for
    Haskell. See Note [Info Offset] in "GHC.CmmToAsm.Dwarf.Types" for more details.

    Note [Unwind pseudo-instruction in Cmm]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    One of the possible CmmNodes is a CmmUnwind pseudo-instruction. It doesn't
    generate any assembly, but controls what DWARF unwinding information gets
    generated.

    It's important to understand what ranges of code the unwind pseudo-instruction
    refers to.
    For a sequence of CmmNodes like:

      A // starts at addr X and ends at addr Y-1
      unwind Sp = Just Sp + 16;
      B // starts at addr Y and ends at addr Z

    the unwind statement reflects the state after A has executed, but before B
    has executed. If you consult the Note [Debugging DWARF unwinding info], the
    LOC this information will end up in is Y.
    -}

    -- | A label associated with an 'UnwindTable'
    data UnwindPoint = UnwindPoint !CLabel !UnwindTable

    instance OutputableP env CLabel => OutputableP env UnwindPoint where
      pdoc :: env -> UnwindPoint -> SDoc
    pdoc env
    env (UnwindPoint CLabel
    lbl UnwindTable
    uws) =
          SDoc -> SDoc
    braces (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ env -> CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc env
    env CLabel
    lbl SDoc -> SDoc -> SDoc
    <> SDoc
    colon
          SDoc -> SDoc -> SDoc
    <+> [SDoc] -> SDoc
    hsep (SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    comma ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $ ((GlobalReg, Maybe UnwindExpr) -> SDoc)
    -> [(GlobalReg, Maybe UnwindExpr)] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (GlobalReg, Maybe UnwindExpr) -> SDoc
    pprUw ([(GlobalReg, Maybe UnwindExpr)] -> [SDoc])
    -> [(GlobalReg, Maybe UnwindExpr)] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $ UnwindTable -> [(GlobalReg, Maybe UnwindExpr)]
    forall k a. Map k a -> [(k, a)]
    Map.toList UnwindTable
    uws)
        where
          pprUw :: (GlobalReg, Maybe UnwindExpr) -> SDoc
    pprUw (GlobalReg
    g, Maybe UnwindExpr
    expr) = GlobalReg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr GlobalReg
    g SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    '=' SDoc -> SDoc -> SDoc
    <> env -> Maybe UnwindExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc env
    env Maybe UnwindExpr
    expr

    -- | Maps registers to expressions that yield their "old" values
    -- further up the stack. Most interesting for the stack pointer @Sp@,
    -- but might be useful to document saved registers, too. Note that a
    -- register's value will be 'Nothing' when the register's previous
    -- value cannot be reconstructed.
    type UnwindTable = Map.Map GlobalReg (Maybe UnwindExpr)

    -- | Expressions, used for unwind information
    data UnwindExpr = UwConst !Int                  -- ^ literal value
                    | UwReg !GlobalReg !Int         -- ^ register plus offset
                    | UwDeref UnwindExpr            -- ^ pointer dereferencing
                    | UwLabel CLabel
                    | UwPlus UnwindExpr UnwindExpr
                    | UwMinus UnwindExpr UnwindExpr
                    | UwTimes UnwindExpr UnwindExpr
                    deriving (UnwindExpr -> UnwindExpr -> Bool
    (UnwindExpr -> UnwindExpr -> Bool)
    -> (UnwindExpr -> UnwindExpr -> Bool) -> Eq UnwindExpr
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: UnwindExpr -> UnwindExpr -> Bool
    $c/= :: UnwindExpr -> UnwindExpr -> Bool
    == :: UnwindExpr -> UnwindExpr -> Bool
    $c== :: UnwindExpr -> UnwindExpr -> Bool
    Eq)

    instance OutputableP env CLabel => OutputableP env UnwindExpr where
      pdoc :: env -> UnwindExpr -> SDoc
    pdoc = Rational -> env -> UnwindExpr -> SDoc
    forall env.
    OutputableP env CLabel =>
    Rational -> env -> UnwindExpr -> SDoc
    pprUnwindExpr Rational
    0

    pprUnwindExpr :: OutputableP env CLabel => Rational -> env -> UnwindExpr -> SDoc
    pprUnwindExpr :: forall env.
    OutputableP env CLabel =>
    Rational -> env -> UnwindExpr -> SDoc
    pprUnwindExpr Rational
    p env
    env = \case
      UwConst Int
    i     -> Int -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Int
    i
      UwReg GlobalReg
    g Int
    0     -> GlobalReg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr GlobalReg
    g
      UwReg GlobalReg
    g Int
    x     -> Rational -> env -> UnwindExpr -> SDoc
    forall env.
    OutputableP env CLabel =>
    Rational -> env -> UnwindExpr -> SDoc
    pprUnwindExpr Rational
    p env
    env (UnwindExpr -> UnwindExpr -> UnwindExpr
    UwPlus (GlobalReg -> Int -> UnwindExpr
    UwReg GlobalReg
    g Int
    0) (Int -> UnwindExpr
    UwConst Int
    x))
      UwDeref UnwindExpr
    e     -> Char -> SDoc
    char Char
    '*' SDoc -> SDoc -> SDoc
    <> Rational -> env -> UnwindExpr -> SDoc
    forall env.
    OutputableP env CLabel =>
    Rational -> env -> UnwindExpr -> SDoc
    pprUnwindExpr Rational
    3 env
    env UnwindExpr
    e
      UwLabel CLabel
    l     -> env -> CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc env
    env CLabel
    l
      UwPlus UnwindExpr
    e0 UnwindExpr
    e1
       | Rational
    p Rational -> Rational -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Rational
    0     -> Rational -> env -> UnwindExpr -> SDoc
    forall env.
    OutputableP env CLabel =>
    Rational -> env -> UnwindExpr -> SDoc
    pprUnwindExpr Rational
    0 env
    env UnwindExpr
    e0 SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    '+' SDoc -> SDoc -> SDoc
    <> Rational -> env -> UnwindExpr -> SDoc
    forall env.
    OutputableP env CLabel =>
    Rational -> env -> UnwindExpr -> SDoc
    pprUnwindExpr Rational
    0 env
    env UnwindExpr
    e1
      UwMinus UnwindExpr
    e0 UnwindExpr
    e1
       | Rational
    p Rational -> Rational -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Rational
    0     -> Rational -> env -> UnwindExpr -> SDoc
    forall env.
    OutputableP env CLabel =>
    Rational -> env -> UnwindExpr -> SDoc
    pprUnwindExpr Rational
    1 env
    env UnwindExpr
    e0 SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    '-' SDoc -> SDoc -> SDoc
    <> Rational -> env -> UnwindExpr -> SDoc
    forall env.
    OutputableP env CLabel =>
    Rational -> env -> UnwindExpr -> SDoc
    pprUnwindExpr Rational
    1 env
    env UnwindExpr
    e1
      UwTimes UnwindExpr
    e0 UnwindExpr
    e1
       | Rational
    p Rational -> Rational -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Rational
    1     -> Rational -> env -> UnwindExpr -> SDoc
    forall env.
    OutputableP env CLabel =>
    Rational -> env -> UnwindExpr -> SDoc
    pprUnwindExpr Rational
    2 env
    env UnwindExpr
    e0 SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    '*' SDoc -> SDoc -> SDoc
    <> Rational -> env -> UnwindExpr -> SDoc
    forall env.
    OutputableP env CLabel =>
    Rational -> env -> UnwindExpr -> SDoc
    pprUnwindExpr Rational
    2 env
    env UnwindExpr
    e1
      UnwindExpr
    other         -> SDoc -> SDoc
    parens (Rational -> env -> UnwindExpr -> SDoc
    forall env.
    OutputableP env CLabel =>
    Rational -> env -> UnwindExpr -> SDoc
    pprUnwindExpr Rational
    0 env
    env UnwindExpr
    other)

    -- | Conversion of Cmm expressions to unwind expressions. We check for
    -- unsupported operator usages and simplify the expression as far as
    -- possible.
    toUnwindExpr :: Platform -> CmmExpr -> UnwindExpr
    toUnwindExpr :: Platform -> CmmExpr -> UnwindExpr
    toUnwindExpr Platform
    _ (CmmLit (CmmInt Integer
    i Width
    _))       = Int -> UnwindExpr
    UwConst (Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    i)
    toUnwindExpr Platform
    _ (CmmLit (CmmLabel CLabel
    l))       = CLabel -> UnwindExpr
    UwLabel CLabel
    l
    toUnwindExpr Platform
    _ (CmmRegOff (CmmGlobal GlobalReg
    g) Int
    i) = GlobalReg -> Int -> UnwindExpr
    UwReg GlobalReg
    g Int
    i
    toUnwindExpr Platform
    _ (CmmReg (CmmGlobal GlobalReg
    g))      = GlobalReg -> Int -> UnwindExpr
    UwReg GlobalReg
    g Int
    0
    toUnwindExpr Platform
    platform (CmmLoad CmmExpr
    e CmmType
    _ AlignmentSpec
    _)             = UnwindExpr -> UnwindExpr
    UwDeref (Platform -> CmmExpr -> UnwindExpr
    toUnwindExpr Platform
    platform CmmExpr
    e)
    toUnwindExpr Platform
    platform e :: CmmExpr
    e@(CmmMachOp MachOp
    op [CmmExpr
    e1, CmmExpr
    e2])   =
      case (MachOp
    op, Platform -> CmmExpr -> UnwindExpr
    toUnwindExpr Platform
    platform CmmExpr
    e1, Platform -> CmmExpr -> UnwindExpr
    toUnwindExpr Platform
    platform CmmExpr
    e2) of
        (MO_Add{}, UwReg GlobalReg
    r Int
    x, UwConst Int
    y) -> GlobalReg -> Int -> UnwindExpr
    UwReg GlobalReg
    r (Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    y)
        (MO_Sub{}, UwReg GlobalReg
    r Int
    x, UwConst Int
    y) -> GlobalReg -> Int -> UnwindExpr
    UwReg GlobalReg
    r (Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    y)
        (MO_Add{}, UwConst Int
    x, UwReg GlobalReg
    r Int
    y) -> GlobalReg -> Int -> UnwindExpr
    UwReg GlobalReg
    r (Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    y)
        (MO_Add{}, UwConst Int
    x, UwConst Int
    y) -> Int -> UnwindExpr
    UwConst (Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    y)
        (MO_Sub{}, UwConst Int
    x, UwConst Int
    y) -> Int -> UnwindExpr
    UwConst (Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    y)
        (MO_Mul{}, UwConst Int
    x, UwConst Int
    y) -> Int -> UnwindExpr
    UwConst (Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    y)
        (MO_Add{}, UnwindExpr
    u1,        UnwindExpr
    u2       ) -> UnwindExpr -> UnwindExpr -> UnwindExpr
    UwPlus UnwindExpr
    u1 UnwindExpr
    u2
        (MO_Sub{}, UnwindExpr
    u1,        UnwindExpr
    u2       ) -> UnwindExpr -> UnwindExpr -> UnwindExpr
    UwMinus UnwindExpr
    u1 UnwindExpr
    u2
        (MO_Mul{}, UnwindExpr
    u1,        UnwindExpr
    u2       ) -> UnwindExpr -> UnwindExpr -> UnwindExpr
    UwTimes UnwindExpr
    u1 UnwindExpr
    u2
        (MachOp, UnwindExpr, UnwindExpr)
    _otherwise -> String -> SDoc -> UnwindExpr
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "Unsupported operator in unwind expression!"
                               (Platform -> CmmExpr -> SDoc
    pprExpr Platform
    platform CmmExpr
    e)
    toUnwindExpr Platform
    platform CmmExpr
    e
      = String -> SDoc -> UnwindExpr
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "Unsupported unwind expression!" (Platform -> CmmExpr -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmExpr
    e)