    module GHC.CmmToAsm.Dwarf (
      dwarfGen
      ) where

    import GHC.Prelude

    import GHC.Cmm.CLabel
    import GHC.Cmm.Expr
    import GHC.Data.FastString
    import GHC.Settings.Config ( cProjectName, cProjectVersion )
    import GHC.Types.Tickish   ( CmmTickish, GenTickish(..) )
    import GHC.Cmm.DebugBlock
    import GHC.Unit.Module
    import GHC.Utils.Outputable
    import GHC.Platform
    import GHC.Types.Unique
    import GHC.Types.Unique.Supply

    import GHC.CmmToAsm.Dwarf.Constants
    import GHC.CmmToAsm.Dwarf.Types
    import GHC.CmmToAsm.Config

    import Control.Arrow    ( first )
    import Control.Monad    ( mfilter )
    import Data.Maybe
    import Data.List        ( sortBy )
    import Data.Ord         ( comparing )
    import qualified Data.Map as Map
    import System.FilePath

    import qualified GHC.Cmm.Dataflow.Label as H

    -- | Generate DWARF/debug information
    dwarfGen :: IsDoc doc => String -> NCGConfig -> ModLocation -> UniqSupply -> [DebugBlock]
                -> (doc, UniqSupply)
    dwarfGen :: forall doc.
    IsDoc doc =>
    String
    -> NCGConfig
    -> ModLocation
    -> UniqSupply
    -> [DebugBlock]
    -> (doc, UniqSupply)
    dwarfGen String
    _        NCGConfig
    _      ModLocation
    _      UniqSupply
    us []     = (doc
    forall doc. IsOutput doc => doc
    empty, UniqSupply
    us)
    dwarfGen String
    compPath NCGConfig
    config ModLocation
    modLoc UniqSupply
    us [DebugBlock]
    blocks =
      let platform :: Platform
    platform = NCGConfig -> Platform
    ncgPlatform NCGConfig
    config

          -- Convert debug data structures to DWARF info records
          procs :: [DebugBlock]
    procs = [DebugBlock] -> [DebugBlock]
    debugSplitProcs [DebugBlock]
    blocks
          stripBlocks :: DebugBlock -> DebugBlock
    stripBlocks DebugBlock
    dbg
            | NCGConfig -> Bool
    ncgDwarfStripBlockInfo NCGConfig
    config = DebugBlock
    dbg { dblBlocks = [] }
            | Bool
    otherwise                     = DebugBlock
    dbg
          lowLabel :: CLabel
    lowLabel = DebugBlock -> CLabel
    dblCLabel (DebugBlock -> CLabel) -> DebugBlock -> CLabel
    forall a b. (a -> b) -> a -> b
    $ [DebugBlock] -> DebugBlock
    forall a. HasCallStack => [a] -> a
    head [DebugBlock]
    procs
          highLabel :: CLabel
    highLabel = CLabel -> CLabel
    mkAsmTempProcEndLabel (CLabel -> CLabel) -> CLabel -> CLabel
    forall a b. (a -> b) -> a -> b
    $ DebugBlock -> CLabel
    dblCLabel (DebugBlock -> CLabel) -> DebugBlock -> CLabel
    forall a b. (a -> b) -> a -> b
    $ [DebugBlock] -> DebugBlock
    forall a. HasCallStack => [a] -> a
    last [DebugBlock]
    procs
          dwarfUnit :: DwarfInfo
    dwarfUnit = DwarfCompileUnit
            { dwChildren :: [DwarfInfo]
    dwChildren = (DebugBlock -> DwarfInfo) -> [DebugBlock] -> [DwarfInfo]
    forall a b. (a -> b) -> [a] -> [b]
    map (NCGConfig -> DebugBlock -> DwarfInfo
    procToDwarf NCGConfig
    config) ((DebugBlock -> DebugBlock) -> [DebugBlock] -> [DebugBlock]
    forall a b. (a -> b) -> [a] -> [b]
    map DebugBlock -> DebugBlock
    stripBlocks [DebugBlock]
    procs)
            , dwName :: String
    dwName = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "" (ModLocation -> Maybe String
    ml_hs_file ModLocation
    modLoc)
            , dwCompDir :: String
    dwCompDir = String -> String
    addTrailingPathSeparator String
    compPath
            , dwProducer :: String
    dwProducer = String
    cProjectName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    cProjectVersion
            , dwLowLabel :: CLabel
    dwLowLabel = CLabel
    lowLabel
            , dwHighLabel :: CLabel
    dwHighLabel = CLabel
    highLabel
            }

          -- Check whether we have any source code information, so we do not
          -- end up writing a pointer to an empty .debug_line section
          -- (dsymutil on Mac Os gets confused by this).
          haveSrcIn :: DebugBlock -> Bool
    haveSrcIn DebugBlock
    blk = Maybe CmmTickish -> Bool
    forall a. Maybe a -> Bool
    isJust (DebugBlock -> Maybe CmmTickish
    dblSourceTick DebugBlock
    blk) Bool -> Bool -> Bool
    && Maybe Int -> Bool
    forall a. Maybe a -> Bool
    isJust (DebugBlock -> Maybe Int
    dblPosition DebugBlock
    blk)
                          Bool -> Bool -> Bool
    || (DebugBlock -> Bool) -> [DebugBlock] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any DebugBlock -> Bool
    haveSrcIn (DebugBlock -> [DebugBlock]
    dblBlocks DebugBlock
    blk)
          haveSrc :: Bool
    haveSrc = (DebugBlock -> Bool) -> [DebugBlock] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any DebugBlock -> Bool
    haveSrcIn [DebugBlock]
    procs

      -- .debug_abbrev section: Declare the format we're using
          abbrevSct :: doc
    abbrevSct = Platform -> Bool -> doc
    forall doc. IsDoc doc => Platform -> Bool -> doc
    pprAbbrevDecls Platform
    platform Bool
    haveSrc

      -- .debug_info section: Information records on procedures and blocks
          -- unique to identify start and end compilation unit .debug_inf
          (Unique
    unitU, UniqSupply
    us') = UniqSupply -> (Unique, UniqSupply)
    takeUniqFromSupply UniqSupply
    us
          infoSct :: doc
    infoSct = [doc] -> doc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ Line doc -> doc
    forall doc. IsDoc doc => Line doc -> doc
    line (Line doc
    forall doc. IsLine doc => doc
    dwarfInfoLabel Line doc -> Line doc -> Line doc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Line doc
    forall doc. IsLine doc => doc
    colon)
                         , Platform -> doc
    forall doc. IsDoc doc => Platform -> doc
    dwarfInfoSection Platform
    platform
                         , Platform -> Unique -> doc
    forall doc. IsDoc doc => Platform -> Unique -> doc
    compileUnitHeader Platform
    platform Unique
    unitU
                         , Platform -> Bool -> DwarfInfo -> doc
    forall doc. IsDoc doc => Platform -> Bool -> DwarfInfo -> doc
    pprDwarfInfo Platform
    platform Bool
    haveSrc DwarfInfo
    dwarfUnit
                         , Platform -> Unique -> doc
    forall doc. IsDoc doc => Platform -> Unique -> doc
    compileUnitFooter Platform
    platform Unique
    unitU
                         ]

      -- .debug_line section: Generated mainly by the assembler, but we
      -- need to label it
          lineSct :: doc
    lineSct = Platform -> doc
    forall doc. IsDoc doc => Platform -> doc
    dwarfLineSection Platform
    platform doc -> doc -> doc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                    Line doc -> doc
    forall doc. IsDoc doc => Line doc -> doc
    line (Line doc
    forall doc. IsLine doc => doc
    dwarfLineLabel Line doc -> Line doc -> Line doc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Line doc
    forall doc. IsLine doc => doc
    colon)

      -- .debug_frame section: Information about the layout of the GHC stack
          (Unique
    framesU, UniqSupply
    us'') = UniqSupply -> (Unique, UniqSupply)
    takeUniqFromSupply UniqSupply
    us'
          frameSct :: doc
    frameSct = Platform -> doc
    forall doc. IsDoc doc => Platform -> doc
    dwarfFrameSection Platform
    platform doc -> doc -> doc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                     Line doc -> doc
    forall doc. IsDoc doc => Line doc -> doc
    line (Line doc
    forall doc. IsLine doc => doc
    dwarfFrameLabel Line doc -> Line doc -> Line doc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Line doc
    forall doc. IsLine doc => doc
    colon) doc -> doc -> doc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                     Platform -> DwarfFrame -> doc
    forall doc. IsDoc doc => Platform -> DwarfFrame -> doc
    pprDwarfFrame Platform
    platform (Platform -> Unique -> [DebugBlock] -> DwarfFrame
    debugFrame Platform
    platform Unique
    framesU [DebugBlock]
    procs)

      -- .aranges section: Information about the bounds of compilation units
          aranges' :: [DwarfARange]
    aranges' | NCGConfig -> Bool
    ncgSplitSections NCGConfig
    config = (DebugBlock -> DwarfARange) -> [DebugBlock] -> [DwarfARange]
    forall a b. (a -> b) -> [a] -> [b]
    map DebugBlock -> DwarfARange
    mkDwarfARange [DebugBlock]
    procs
                   | Bool
    otherwise               = [CLabel -> CLabel -> DwarfARange
    DwarfARange CLabel
    lowLabel CLabel
    highLabel]
          aranges :: doc
    aranges = Platform -> doc
    forall doc. IsDoc doc => Platform -> doc
    dwarfARangesSection Platform
    platform doc -> doc -> doc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Platform -> [DwarfARange] -> Unique -> doc
    forall doc. IsDoc doc => Platform -> [DwarfARange] -> Unique -> doc
    pprDwarfARanges Platform
    platform [DwarfARange]
    aranges' Unique
    unitU

      in (doc
    infoSct doc -> doc -> doc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ doc
    abbrevSct doc -> doc -> doc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ doc
    lineSct doc -> doc -> doc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ doc
    frameSct doc -> doc -> doc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ doc
    aranges, UniqSupply
    us'')
    {-# SPECIALIZE dwarfGen :: String -> NCGConfig -> ModLocation -> UniqSupply -> [DebugBlock] -> (SDoc, UniqSupply) #-}
    {-# SPECIALIZE dwarfGen :: String -> NCGConfig -> ModLocation -> UniqSupply -> [DebugBlock] -> (HDoc, UniqSupply) #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

    -- | Build an address range entry for one proc.
    -- With split sections, each proc needs its own entry, since they may get
    -- scattered in the final binary. Without split sections, we could make a
    -- single arange based on the first/last proc.
    mkDwarfARange :: DebugBlock -> DwarfARange
    mkDwarfARange :: DebugBlock -> DwarfARange
    mkDwarfARange DebugBlock
    proc = CLabel -> CLabel -> DwarfARange
    DwarfARange CLabel
    lbl CLabel
    end
      where
        lbl :: CLabel
    lbl = DebugBlock -> CLabel
    dblCLabel DebugBlock
    proc
        end :: CLabel
    end = CLabel -> CLabel
    mkAsmTempProcEndLabel CLabel
    lbl

    -- | Header for a compilation unit, establishing global format
    -- parameters
    compileUnitHeader :: IsDoc doc => Platform -> Unique -> doc
    compileUnitHeader :: forall doc. IsDoc doc => Platform -> Unique -> doc
    compileUnitHeader Platform
    platform Unique
    unitU =
      let cuLabel :: CLabel
    cuLabel = Unique -> CLabel
    forall a. Uniquable a => a -> CLabel
    mkAsmTempLabel Unique
    unitU  -- sits right before initialLength field
          length :: Line doc
    length = Platform -> CLabel -> Line doc
    forall doc. IsLine doc => Platform -> CLabel -> doc
    pprAsmLabel Platform
    platform (CLabel -> CLabel
    mkAsmTempEndLabel CLabel
    cuLabel) Line doc -> Line doc -> Line doc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Char -> Line doc
    forall doc. IsLine doc => Char -> doc
    char Char
    '-' Line doc -> Line doc -> Line doc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Platform -> CLabel -> Line doc
    forall doc. IsLine doc => Platform -> CLabel -> doc
    pprAsmLabel Platform
    platform CLabel
    cuLabel
                   Line doc -> Line doc -> Line doc
    forall doc. IsLine doc => doc -> doc -> doc
    <> String -> Line doc
    forall doc. IsLine doc => String -> doc
    text String
    "-4"       -- length of initialLength field
      in [doc] -> doc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ Line doc -> doc
    forall doc. IsDoc doc => Line doc -> doc
    line (Platform -> CLabel -> Line doc
    forall doc. IsLine doc => Platform -> CLabel -> doc
    pprAsmLabel Platform
    platform CLabel
    cuLabel Line doc -> Line doc -> Line doc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Line doc
    forall doc. IsLine doc => doc
    colon)
              , Line doc -> doc
    forall doc. IsDoc doc => Line doc -> doc
    line (String -> Line doc
    forall doc. IsLine doc => String -> doc
    text String
    "\t.long " Line doc -> Line doc -> Line doc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Line doc
    length)  -- compilation unit size
              , Word16 -> doc
    forall doc. IsDoc doc => Word16 -> doc
    pprHalf Word16
    3                          -- DWARF version
              , Platform -> Line doc -> Line doc -> doc
    forall doc. IsDoc doc => Platform -> Line doc -> Line doc -> doc
    sectionOffset Platform
    platform Line doc
    forall doc. IsLine doc => doc
    dwarfAbbrevLabel Line doc
    forall doc. IsLine doc => doc
    dwarfAbbrevLabel
                                                   -- abbrevs offset
              , Line doc -> doc
    forall doc. IsDoc doc => Line doc -> doc
    line (String -> Line doc
    forall doc. IsLine doc => String -> doc
    text String
    "\t.byte " Line doc -> Line doc -> Line doc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Int -> Line doc
    forall doc. IsLine doc => Int -> doc
    int (Platform -> Int
    platformWordSizeInBytes Platform
    platform)) -- word size
              ]

    -- | Compilation unit footer, mainly establishing size of debug sections
    compileUnitFooter :: IsDoc doc => Platform -> Unique -> doc
    compileUnitFooter :: forall doc. IsDoc doc => Platform -> Unique -> doc
    compileUnitFooter Platform
    platform Unique
    unitU =
      let cuEndLabel :: CLabel
    cuEndLabel = CLabel -> CLabel
    mkAsmTempEndLabel (CLabel -> CLabel) -> CLabel -> CLabel
    forall a b. (a -> b) -> a -> b
    $ Unique -> CLabel
    forall a. Uniquable a => a -> CLabel
    mkAsmTempLabel Unique
    unitU
      in Line doc -> doc
    forall doc. IsDoc doc => Line doc -> doc
    line (Platform -> CLabel -> Line doc
    forall doc. IsLine doc => Platform -> CLabel -> doc
    pprAsmLabel Platform
    platform CLabel
    cuEndLabel Line doc -> Line doc -> Line doc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Line doc
    forall doc. IsLine doc => doc
    colon)

    -- | Splits the blocks by procedures. In the result all nested blocks
    -- will come from the same procedure as the top-level block. See
    -- Note [Splitting DebugBlocks] for details.
    debugSplitProcs :: [DebugBlock] -> [DebugBlock]
    debugSplitProcs :: [DebugBlock] -> [DebugBlock]
    debugSplitProcs [DebugBlock]
    b = [[DebugBlock]] -> [DebugBlock]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[DebugBlock]] -> [DebugBlock]) -> [[DebugBlock]] -> [DebugBlock]
    forall a b. (a -> b) -> a -> b
    $ LabelMap [DebugBlock] -> [[DebugBlock]]
    forall a. LabelMap a -> [a]
    H.mapElems (LabelMap [DebugBlock] -> [[DebugBlock]])
    -> LabelMap [DebugBlock] -> [[DebugBlock]]
    forall a b. (a -> b) -> a -> b
    $ [LabelMap [DebugBlock]] -> LabelMap [DebugBlock]
    forall {a}. [LabelMap [a]] -> LabelMap [a]
    mergeMaps ([LabelMap [DebugBlock]] -> LabelMap [DebugBlock])
    -> [LabelMap [DebugBlock]] -> LabelMap [DebugBlock]
    forall a b. (a -> b) -> a -> b
    $ (DebugBlock -> LabelMap [DebugBlock])
    -> [DebugBlock] -> [LabelMap [DebugBlock]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Maybe DebugBlock -> DebugBlock -> LabelMap [DebugBlock]
    split Maybe DebugBlock
    forall a. Maybe a
    Nothing) [DebugBlock]
    b
      where mergeMaps :: [LabelMap [a]] -> LabelMap [a]
    mergeMaps = (LabelMap [a] -> LabelMap [a] -> LabelMap [a])
    -> LabelMap [a] -> [LabelMap [a]] -> LabelMap [a]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((Label -> [a] -> [a] -> [a])
    -> LabelMap [a] -> LabelMap [a] -> LabelMap [a]
    forall v.
    (Label -> v -> v -> v) -> LabelMap v -> LabelMap v -> LabelMap v
    H.mapUnionWithKey (([a] -> [a] -> [a]) -> Label -> [a] -> [a] -> [a]
    forall a b. a -> b -> a
    const [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    (++))) LabelMap [a]
    forall v. LabelMap v
    H.mapEmpty
            split :: Maybe DebugBlock -> DebugBlock -> H.LabelMap [DebugBlock]
            split :: Maybe DebugBlock -> DebugBlock -> LabelMap [DebugBlock]
    split Maybe DebugBlock
    parent DebugBlock
    blk = Label
    -> [DebugBlock] -> LabelMap [DebugBlock] -> LabelMap [DebugBlock]
    forall v. Label -> v -> LabelMap v -> LabelMap v
    H.mapInsert Label
    prc [DebugBlock
    blk'] LabelMap [DebugBlock]
    nested
              where prc :: Label
    prc = DebugBlock -> Label
    dblProcedure DebugBlock
    blk
                    blk' :: DebugBlock
    blk' = DebugBlock
    blk { dblBlocks = own_blks
                               , dblParent = parent
                               }
                    own_blks :: [DebugBlock]
    own_blks = [DebugBlock] -> Maybe [DebugBlock] -> [DebugBlock]
    forall a. a -> Maybe a -> a
    fromMaybe [] (Maybe [DebugBlock] -> [DebugBlock])
    -> Maybe [DebugBlock] -> [DebugBlock]
    forall a b. (a -> b) -> a -> b
    $ Label -> LabelMap [DebugBlock] -> Maybe [DebugBlock]
    forall a. Label -> LabelMap a -> Maybe a
    H.mapLookup Label
    prc LabelMap [DebugBlock]
    nested
                    nested :: LabelMap [DebugBlock]
    nested = [LabelMap [DebugBlock]] -> LabelMap [DebugBlock]
    forall {a}. [LabelMap [a]] -> LabelMap [a]
    mergeMaps ([LabelMap [DebugBlock]] -> LabelMap [DebugBlock])
    -> [LabelMap [DebugBlock]] -> LabelMap [DebugBlock]
    forall a b. (a -> b) -> a -> b
    $ (DebugBlock -> LabelMap [DebugBlock])
    -> [DebugBlock] -> [LabelMap [DebugBlock]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Maybe DebugBlock -> DebugBlock -> LabelMap [DebugBlock]
    split Maybe DebugBlock
    parent') ([DebugBlock] -> [LabelMap [DebugBlock]])
    -> [DebugBlock] -> [LabelMap [DebugBlock]]
    forall a b. (a -> b) -> a -> b
    $ DebugBlock -> [DebugBlock]
    dblBlocks DebugBlock
    blk
                    -- Figure out who should be the parent of nested blocks.
                    -- If @blk@ is optimized out then it isn't a good choice
                    -- and we just use its parent.
                    parent' :: Maybe DebugBlock
    parent'
                      | Maybe Int
    Nothing <- DebugBlock -> Maybe Int
    dblPosition DebugBlock
    blk = Maybe DebugBlock
    parent
                      | Bool
    otherwise                  = DebugBlock -> Maybe DebugBlock
    forall a. a -> Maybe a
    Just DebugBlock
    blk

    {-
    Note [Splitting DebugBlocks]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    DWARF requires that we break up the nested DebugBlocks produced from
    the C-- AST. For instance, we begin with tick trees containing nested procs.
    For example,

        proc A [tick1, tick2]
          block B [tick3]
            proc C [tick4]

    when producing DWARF we need to procs (which are represented in DWARF as
    TAG_subprogram DIEs) to be top-level DIEs. debugSplitProcs is responsible for
    this transform, pulling out the nested procs into top-level procs.

    However, in doing this we need to be careful to preserve the parentage of the
    nested procs. This is the reason DebugBlocks carry the dblParent field, allowing
    us to reorganize the above tree as,

        proc A [tick1, tick2]
          block B [tick3]
        proc C [tick4] parent=B

    Here we have annotated the new proc C with an attribute giving its original
    parent, B.
    -}

    -- | Generate DWARF info for a procedure debug block
    procToDwarf :: NCGConfig -> DebugBlock -> DwarfInfo
    procToDwarf :: NCGConfig -> DebugBlock -> DwarfInfo
    procToDwarf NCGConfig
    config DebugBlock
    prc
      = DwarfSubprogram { dwChildren :: [DwarfInfo]
    dwChildren = (DebugBlock -> DwarfInfo) -> [DebugBlock] -> [DwarfInfo]
    forall a b. (a -> b) -> [a] -> [b]
    map (NCGConfig -> DebugBlock -> DwarfInfo
    blockToDwarf NCGConfig
    config) (DebugBlock -> [DebugBlock]
    dblBlocks DebugBlock
    prc)
                        , dwName :: String
    dwName     = case DebugBlock -> Maybe CmmTickish
    dblSourceTick DebugBlock
    prc of
                             Just s :: CmmTickish
    s@SourceNote{} -> case CmmTickish -> LexicalFastString
    forall (pass :: TickishPass). GenTickish pass -> LexicalFastString
    sourceName CmmTickish
    s of
                                LexicalFastString FastString
    s -> FastString -> String
    unpackFS FastString
    s
                             Maybe CmmTickish
    _otherwise -> Label -> String
    forall a. Show a => a -> String
    show (DebugBlock -> Label
    dblLabel DebugBlock
    prc)
                        , dwLabel :: CLabel
    dwLabel    = DebugBlock -> CLabel
    dblCLabel DebugBlock
    prc
                        , dwParent :: Maybe CLabel
    dwParent   = (CLabel -> CLabel) -> Maybe CLabel -> Maybe CLabel
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap CLabel -> CLabel
    mkAsmTempDieLabel
                                       (Maybe CLabel -> Maybe CLabel) -> Maybe CLabel -> Maybe CLabel
    forall a b. (a -> b) -> a -> b
    $ (CLabel -> Bool) -> Maybe CLabel -> Maybe CLabel
    forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
    mfilter CLabel -> Bool
    goodParent
                                       (Maybe CLabel -> Maybe CLabel) -> Maybe CLabel -> Maybe CLabel
    forall a b. (a -> b) -> a -> b
    $ (DebugBlock -> CLabel) -> Maybe DebugBlock -> Maybe CLabel
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DebugBlock -> CLabel
    dblCLabel (DebugBlock -> Maybe DebugBlock
    dblParent DebugBlock
    prc)
                        }
      where
      goodParent :: CLabel -> Bool
    goodParent CLabel
    a | CLabel
    a CLabel -> CLabel -> Bool
    forall a. Eq a => a -> a -> Bool
    == DebugBlock -> CLabel
    dblCLabel DebugBlock
    prc = Bool
    False
                   -- Omit parent if it would be self-referential
      goodParent CLabel
    a | Bool -> Bool
    not (CLabel -> Bool
    externallyVisibleCLabel CLabel
    a)
                   , NCGConfig -> Bool
    ncgDwarfStripBlockInfo NCGConfig
    config = Bool
    False
                   -- If we strip block information, don't refer to blocks.
                   -- Fixes #14894.
      goodParent CLabel
    _ = Bool
    True

    -- | Generate DWARF info for a block
    blockToDwarf :: NCGConfig -> DebugBlock -> DwarfInfo
    blockToDwarf :: NCGConfig -> DebugBlock -> DwarfInfo
    blockToDwarf NCGConfig
    config DebugBlock
    blk
      = DwarfBlock { dwChildren :: [DwarfInfo]
    dwChildren = (DebugBlock -> DwarfInfo) -> [DebugBlock] -> [DwarfInfo]
    forall a b. (a -> b) -> [a] -> [b]
    map (NCGConfig -> DebugBlock -> DwarfInfo
    blockToDwarf NCGConfig
    config) (DebugBlock -> [DebugBlock]
    dblBlocks DebugBlock
    blk) [DwarfInfo] -> [DwarfInfo] -> [DwarfInfo]
    forall a. [a] -> [a] -> [a]
    ++ [DwarfInfo]
    srcNotes
                   , dwLabel :: CLabel
    dwLabel    = DebugBlock -> CLabel
    dblCLabel DebugBlock
    blk
                   , dwMarker :: Maybe CLabel
    dwMarker   = Maybe CLabel
    marker
                   }
      where
        srcNotes :: [DwarfInfo]
    srcNotes
          | NCGConfig -> Bool
    ncgDwarfSourceNotes NCGConfig
    config = (CmmTickish -> [DwarfInfo]) -> [CmmTickish] -> [DwarfInfo]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap CmmTickish -> [DwarfInfo]
    tickToDwarf (DebugBlock -> [CmmTickish]
    dblTicks DebugBlock
    blk)
          | Bool
    otherwise                  = []

        marker :: Maybe CLabel
    marker
          | Just Int
    _ <- DebugBlock -> Maybe Int
    dblPosition DebugBlock
    blk = 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 -> CLabel) -> Label -> CLabel
    forall a b. (a -> b) -> a -> b
    $ DebugBlock -> Label
    dblLabel DebugBlock
    blk
          | Bool
    otherwise                 = Maybe CLabel
    forall a. Maybe a
    Nothing   -- block was optimized out

    tickToDwarf :: CmmTickish -> [DwarfInfo]
    tickToDwarf :: CmmTickish -> [DwarfInfo]
    tickToDwarf  (SourceNote RealSrcSpan
    ss LexicalFastString
    _) = [RealSrcSpan -> DwarfInfo
    DwarfSrcNote RealSrcSpan
    ss]
    tickToDwarf CmmTickish
    _ = []

    -- | Generates the data for the debug frame section, which encodes the
    -- desired stack unwind behaviour for the debugger
    debugFrame :: Platform -> Unique -> [DebugBlock] -> DwarfFrame
    debugFrame :: Platform -> Unique -> [DebugBlock] -> DwarfFrame
    debugFrame Platform
    p Unique
    u [DebugBlock]
    procs
      = DwarfFrame { dwCieLabel :: CLabel
    dwCieLabel = Unique -> CLabel
    forall a. Uniquable a => a -> CLabel
    mkAsmTempLabel Unique
    u
                   , dwCieInit :: UnwindTable
    dwCieInit  = UnwindTable
    initUws
                   , dwCieProcs :: [DwarfFrameProc]
    dwCieProcs = (DebugBlock -> DwarfFrameProc) -> [DebugBlock] -> [DwarfFrameProc]
    forall a b. (a -> b) -> [a] -> [b]
    map (UnwindTable -> DebugBlock -> DwarfFrameProc
    procToFrame UnwindTable
    initUws) [DebugBlock]
    procs
                   }
      where
        initUws :: UnwindTable
        initUws :: UnwindTable
    initUws = [(GlobalReg, Maybe UnwindExpr)] -> UnwindTable
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(GlobalReg
    Sp, UnwindExpr -> Maybe UnwindExpr
    forall a. a -> Maybe a
    Just (GlobalRegUse -> Int -> UnwindExpr
    UwReg (GlobalReg -> CmmType -> GlobalRegUse
    GlobalRegUse GlobalReg
    Sp (CmmType -> GlobalRegUse) -> CmmType -> GlobalRegUse
    forall a b. (a -> b) -> a -> b
    $ Platform -> CmmType
    bWord Platform
    p) Int
    0))]

    -- | Generates unwind information for a procedure debug block
    procToFrame :: UnwindTable -> DebugBlock -> DwarfFrameProc
    procToFrame :: UnwindTable -> DebugBlock -> DwarfFrameProc
    procToFrame UnwindTable
    initUws DebugBlock
    blk
      = DwarfFrameProc { dwFdeProc :: CLabel
    dwFdeProc    = DebugBlock -> CLabel
    dblCLabel DebugBlock
    blk
                       , dwFdeHasInfo :: Bool
    dwFdeHasInfo = DebugBlock -> Bool
    dblHasInfoTbl DebugBlock
    blk
                       , dwFdeBlocks :: [DwarfFrameBlock]
    dwFdeBlocks  = ((DebugBlock, [UnwindPoint]) -> DwarfFrameBlock)
    -> [(DebugBlock, [UnwindPoint])] -> [DwarfFrameBlock]
    forall a b. (a -> b) -> [a] -> [b]
    map ((DebugBlock -> [UnwindPoint] -> DwarfFrameBlock)
    -> (DebugBlock, [UnwindPoint]) -> DwarfFrameBlock
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry DebugBlock -> [UnwindPoint] -> DwarfFrameBlock
    blockToFrame)
                                            ([(DebugBlock, [UnwindPoint])] -> [(DebugBlock, [UnwindPoint])]
    setHasInfo [(DebugBlock, [UnwindPoint])]
    blockUws)
                       }
      where blockUws :: [(DebugBlock, [UnwindPoint])]
            blockUws :: [(DebugBlock, [UnwindPoint])]
    blockUws = ((Int, (DebugBlock, [UnwindPoint])) -> (DebugBlock, [UnwindPoint]))
    -> [(Int, (DebugBlock, [UnwindPoint]))]
    -> [(DebugBlock, [UnwindPoint])]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, (DebugBlock, [UnwindPoint])) -> (DebugBlock, [UnwindPoint])
    forall a b. (a, b) -> b
    snd ([(Int, (DebugBlock, [UnwindPoint]))]
     -> [(DebugBlock, [UnwindPoint])])
    -> [(Int, (DebugBlock, [UnwindPoint]))]
    -> [(DebugBlock, [UnwindPoint])]
    forall a b. (a -> b) -> a -> b
    $ ((Int, (DebugBlock, [UnwindPoint]))
     -> (Int, (DebugBlock, [UnwindPoint])) -> Ordering)
    -> [(Int, (DebugBlock, [UnwindPoint]))]
    -> [(Int, (DebugBlock, [UnwindPoint]))]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (((Int, (DebugBlock, [UnwindPoint])) -> Int)
    -> (Int, (DebugBlock, [UnwindPoint]))
    -> (Int, (DebugBlock, [UnwindPoint]))
    -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (Int, (DebugBlock, [UnwindPoint])) -> Int
    forall a b. (a, b) -> a
    fst) ([(Int, (DebugBlock, [UnwindPoint]))]
     -> [(Int, (DebugBlock, [UnwindPoint]))])
    -> [(Int, (DebugBlock, [UnwindPoint]))]
    -> [(Int, (DebugBlock, [UnwindPoint]))]
    forall a b. (a -> b) -> a -> b
    $ DebugBlock -> [(Int, (DebugBlock, [UnwindPoint]))]
    flatten DebugBlock
    blk

            flatten :: DebugBlock
                    -> [(Int, (DebugBlock, [UnwindPoint]))]
            flatten :: DebugBlock -> [(Int, (DebugBlock, [UnwindPoint]))]
    flatten b :: DebugBlock
    b@DebugBlock{ dblPosition :: DebugBlock -> Maybe Int
    dblPosition=Maybe Int
    pos, dblUnwind :: DebugBlock -> [UnwindPoint]
    dblUnwind=[UnwindPoint]
    uws, dblBlocks :: DebugBlock -> [DebugBlock]
    dblBlocks=[DebugBlock]
    blocks }
              | Just Int
    p <- Maybe Int
    pos  = (Int
    p, (DebugBlock
    b, [UnwindPoint]
    uws'))(Int, (DebugBlock, [UnwindPoint]))
    -> [(Int, (DebugBlock, [UnwindPoint]))]
    -> [(Int, (DebugBlock, [UnwindPoint]))]
    forall a. a -> [a] -> [a]
    :[(Int, (DebugBlock, [UnwindPoint]))]
    nested
              | Bool
    otherwise      = [(Int, (DebugBlock, [UnwindPoint]))]
    nested -- block was optimized out
              where uws' :: [UnwindPoint]
    uws'   = UnwindTable -> [UnwindPoint] -> [UnwindPoint]
    addDefaultUnwindings UnwindTable
    initUws [UnwindPoint]
    uws
                    nested :: [(Int, (DebugBlock, [UnwindPoint]))]
    nested = (DebugBlock -> [(Int, (DebugBlock, [UnwindPoint]))])
    -> [DebugBlock] -> [(Int, (DebugBlock, [UnwindPoint]))]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap DebugBlock -> [(Int, (DebugBlock, [UnwindPoint]))]
    flatten [DebugBlock]
    blocks

            -- If the current procedure has an info table, then we also say that
            -- its first block has one to ensure that it gets the necessary -1
            -- offset applied to its start address.
            -- See Note [Info Offset] in "GHC.CmmToAsm.Dwarf.Types".
            setHasInfo :: [(DebugBlock, [UnwindPoint])]
                       -> [(DebugBlock, [UnwindPoint])]
            setHasInfo :: [(DebugBlock, [UnwindPoint])] -> [(DebugBlock, [UnwindPoint])]
    setHasInfo [] = []
            setHasInfo ((DebugBlock, [UnwindPoint])
    c0:[(DebugBlock, [UnwindPoint])]
    cs) = (DebugBlock -> DebugBlock)
    -> (DebugBlock, [UnwindPoint]) -> (DebugBlock, [UnwindPoint])
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first DebugBlock -> DebugBlock
    setIt (DebugBlock, [UnwindPoint])
    c0 (DebugBlock, [UnwindPoint])
    -> [(DebugBlock, [UnwindPoint])] -> [(DebugBlock, [UnwindPoint])]
    forall a. a -> [a] -> [a]
    : [(DebugBlock, [UnwindPoint])]
    cs
              where
                setIt :: DebugBlock -> DebugBlock
    setIt DebugBlock
    child =
                  DebugBlock
    child { dblHasInfoTbl = dblHasInfoTbl child
                                          || dblHasInfoTbl blk }

    blockToFrame :: DebugBlock -> [UnwindPoint] -> DwarfFrameBlock
    blockToFrame :: DebugBlock -> [UnwindPoint] -> DwarfFrameBlock
    blockToFrame DebugBlock
    blk [UnwindPoint]
    uws
      = DwarfFrameBlock { dwFdeBlkHasInfo :: Bool
    dwFdeBlkHasInfo = DebugBlock -> Bool
    dblHasInfoTbl DebugBlock
    blk
                        , dwFdeUnwind :: [UnwindPoint]
    dwFdeUnwind     = [UnwindPoint]
    uws
                        }

    addDefaultUnwindings :: UnwindTable -> [UnwindPoint] -> [UnwindPoint]
    addDefaultUnwindings :: UnwindTable -> [UnwindPoint] -> [UnwindPoint]
    addDefaultUnwindings UnwindTable
    tbl [UnwindPoint]
    pts =
        [ CLabel -> UnwindTable -> UnwindPoint
    UnwindPoint CLabel
    lbl (UnwindTable
    tbl' UnwindTable -> UnwindTable -> UnwindTable
    forall a. Monoid a => a -> a -> a
    `mappend` UnwindTable
    tbl)
          -- mappend is left-biased
        | UnwindPoint CLabel
    lbl UnwindTable
    tbl' <- [UnwindPoint]
    pts
        ]