    {-# LANGUAGE TupleSections #-}
    -- This module contains functions which implement
    -- the -finfo-table-map and -fdistinct-constructor-tables flags
    module GHC.Stg.Debug(collectDebugInformation) where

    import GHC.Prelude

    import GHC.Stg.Syntax

    import GHC.Types.Id
    import GHC.Types.Tickish
    import GHC.Core.DataCon
    import GHC.Types.IPE
    import GHC.Unit.Module
    import GHC.Types.Name   ( getName, getOccName, occNameString, nameSrcSpan)
    import GHC.Data.FastString
    import GHC.Driver.Session

    import Control.Monad (when)
    import Control.Monad.Trans.Reader
    import Control.Monad.Trans.State
    import Control.Monad.Trans.Class
    import GHC.Types.Unique.Map
    import GHC.Types.SrcLoc
    import Control.Applicative
    import qualified Data.List.NonEmpty as NE
    import Data.List.NonEmpty (NonEmpty(..))

    data SpanWithLabel = SpanWithLabel RealSrcSpan String

    data R = R { R -> DynFlags
    rDynFlags :: DynFlags, R -> ModLocation
    rModLocation :: ModLocation, R -> Maybe SpanWithLabel
    rSpan :: Maybe SpanWithLabel }

    type M a = ReaderT R (State InfoTableProvMap) a

    withSpan :: (RealSrcSpan, String) -> M a -> M a
    withSpan :: forall a. (RealSrcSpan, String) -> M a -> M a
    withSpan (RealSrcSpan
    new_s, String
    new_l) M a
    act = forall r (m :: * -> *) a.
    (r -> r) -> ReaderT r m a -> ReaderT r m a
    local R -> R
    maybe_replace M a
    act
      where
        maybe_replace :: R -> R
    maybe_replace r :: R
    r@R{ rModLocation :: R -> ModLocation
    rModLocation = ModLocation
    cur_mod, rSpan :: R -> Maybe SpanWithLabel
    rSpan = Just (SpanWithLabel RealSrcSpan
    old_s String
    _old_l) }
          -- prefer spans from the current module
          | forall a. a -> Maybe a
    Just (FastString -> String
    unpackFS forall a b. (a -> b) -> a -> b
    $ RealSrcSpan -> FastString
    srcSpanFile RealSrcSpan
    old_s) forall a. Eq a => a -> a -> Bool
    == ModLocation -> Maybe String
    ml_hs_file ModLocation
    cur_mod
          , forall a. a -> Maybe a
    Just (FastString -> String
    unpackFS forall a b. (a -> b) -> a -> b
    $ RealSrcSpan -> FastString
    srcSpanFile RealSrcSpan
    new_s) forall a. Eq a => a -> a -> Bool
    /= ModLocation -> Maybe String
    ml_hs_file ModLocation
    cur_mod
          = R
    r
        maybe_replace R
    r
          = R
    r { rSpan :: Maybe SpanWithLabel
    rSpan = forall a. a -> Maybe a
    Just (RealSrcSpan -> String -> SpanWithLabel
    SpanWithLabel RealSrcSpan
    new_s String
    new_l) }

    collectDebugInformation :: DynFlags -> ModLocation -> [StgTopBinding] -> ([StgTopBinding], InfoTableProvMap)
    collectDebugInformation :: DynFlags
    -> ModLocation
    -> [StgTopBinding]
    -> ([StgTopBinding], InfoTableProvMap)
    collectDebugInformation DynFlags
    dflags ModLocation
    ml [StgTopBinding]
    bs =
        forall s a. State s a -> s -> (a, s)
    runState (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT (forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM StgTopBinding -> M StgTopBinding
    collectTop [StgTopBinding]
    bs) (DynFlags -> ModLocation -> Maybe SpanWithLabel -> R
    R DynFlags
    dflags ModLocation
    ml forall a. Maybe a
    Nothing)) InfoTableProvMap
    emptyInfoTableProvMap

    collectTop :: StgTopBinding -> M StgTopBinding
    collectTop :: StgTopBinding -> M StgTopBinding
    collectTop (StgTopLifted GenStgBinding 'Vanilla
    t) = forall (pass :: StgPass).
    GenStgBinding pass -> GenStgTopBinding pass
    StgTopLifted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> GenStgBinding 'Vanilla -> M (GenStgBinding 'Vanilla)
    collectStgBind GenStgBinding 'Vanilla
    t
    collectTop StgTopBinding
    tb = forall (m :: * -> *) a. Monad m => a -> m a
    return StgTopBinding
    tb

    collectStgBind :: StgBinding -> M StgBinding
    collectStgBind :: GenStgBinding 'Vanilla -> M (GenStgBinding 'Vanilla)
    collectStgBind  (StgNonRec BinderP 'Vanilla
    bndr GenStgRhs 'Vanilla
    rhs) = do
        GenStgRhs 'Vanilla
    rhs' <- Id -> GenStgRhs 'Vanilla -> M (GenStgRhs 'Vanilla)
    collectStgRhs BinderP 'Vanilla
    bndr GenStgRhs 'Vanilla
    rhs
        forall (m :: * -> *) a. Monad m => a -> m a
    return (forall (pass :: StgPass).
    BinderP pass -> GenStgRhs pass -> GenStgBinding pass
    StgNonRec BinderP 'Vanilla
    bndr GenStgRhs 'Vanilla
    rhs')
    collectStgBind (StgRec [(BinderP 'Vanilla, GenStgRhs 'Vanilla)]
    pairs) = do
        [(Id, GenStgRhs 'Vanilla)]
    es <- forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (\(Id
    b, GenStgRhs 'Vanilla
    e) -> (Id
    b,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Id -> GenStgRhs 'Vanilla -> M (GenStgRhs 'Vanilla)
    collectStgRhs Id
    b GenStgRhs 'Vanilla
    e) [(BinderP 'Vanilla, GenStgRhs 'Vanilla)]
    pairs
        forall (m :: * -> *) a. Monad m => a -> m a
    return (forall (pass :: StgPass).
    [(BinderP pass, GenStgRhs pass)] -> GenStgBinding pass
    StgRec [(Id, GenStgRhs 'Vanilla)]
    es)

    collectStgRhs :: Id -> StgRhs -> M StgRhs
    collectStgRhs :: Id -> GenStgRhs 'Vanilla -> M (GenStgRhs 'Vanilla)
    collectStgRhs Id
    bndr (StgRhsClosure XRhsClosure 'Vanilla
    ext CostCentreStack
    cc UpdateFlag
    us [BinderP 'Vanilla]
    bs GenStgExpr 'Vanilla
    e)= do
      let
        name :: Name
    name = Id -> Name
    idName Id
    bndr
        -- If the name has a span, use that initially as the source position in-case
        -- we don't get anything better.
        with_span :: M (GenStgExpr 'Vanilla) -> M (GenStgExpr 'Vanilla)
    with_span = case Name -> SrcSpan
    nameSrcSpan Name
    name of
                      RealSrcSpan RealSrcSpan
    pos Maybe BufSpan
    _ -> forall a. (RealSrcSpan, String) -> M a -> M a
    withSpan (RealSrcSpan
    pos, OccName -> String
    occNameString (forall a. NamedThing a => a -> OccName
    getOccName Name
    name))
                      SrcSpan
    _ -> forall a. a -> a
    id
      GenStgExpr 'Vanilla
    e' <- M (GenStgExpr 'Vanilla) -> M (GenStgExpr 'Vanilla)
    with_span forall a b. (a -> b) -> a -> b
    $ GenStgExpr 'Vanilla -> M (GenStgExpr 'Vanilla)
    collectExpr GenStgExpr 'Vanilla
    e
      Id -> GenStgExpr 'Vanilla -> M ()
    recordInfo Id
    bndr GenStgExpr 'Vanilla
    e'
      forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ forall (pass :: StgPass).
    XRhsClosure pass
    -> CostCentreStack
    -> UpdateFlag
    -> [BinderP pass]
    -> GenStgExpr pass
    -> GenStgRhs pass
    StgRhsClosure XRhsClosure 'Vanilla
    ext CostCentreStack
    cc UpdateFlag
    us [BinderP 'Vanilla]
    bs GenStgExpr 'Vanilla
    e'
    collectStgRhs Id
    _bndr (StgRhsCon CostCentreStack
    cc DataCon
    dc ConstructorNumber
    _mn [StgTickish]
    ticks [StgArg]
    args) = do
      ConstructorNumber
    n' <- DataCon -> [StgTickish] -> M ConstructorNumber
    numberDataCon DataCon
    dc [StgTickish]
    ticks
      forall (m :: * -> *) a. Monad m => a -> m a
    return (forall (pass :: StgPass).
    CostCentreStack
    -> DataCon
    -> ConstructorNumber
    -> [StgTickish]
    -> [StgArg]
    -> GenStgRhs pass
    StgRhsCon CostCentreStack
    cc DataCon
    dc ConstructorNumber
    n' [StgTickish]
    ticks [StgArg]
    args)

    recordInfo :: Id -> StgExpr -> M ()
    recordInfo :: Id -> GenStgExpr 'Vanilla -> M ()
    recordInfo Id
    bndr GenStgExpr 'Vanilla
    new_rhs = do
      ModLocation
    modLoc <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks R -> ModLocation
    rModLocation
      let
        thisFile :: FastString
    thisFile = forall b a. b -> (a -> b) -> Maybe a -> b
    maybe FastString
    nilFS String -> FastString
    mkFastString forall a b. (a -> b) -> a -> b
    $ ModLocation -> Maybe String
    ml_hs_file ModLocation
    modLoc
        -- A span from the ticks surrounding the new_rhs
        best_span :: Maybe SpanWithLabel
    best_span = FastString -> GenStgExpr 'Vanilla -> Maybe SpanWithLabel
    quickSourcePos FastString
    thisFile GenStgExpr 'Vanilla
    new_rhs
        -- A back-up span if the bndr had a source position, many do not (think internally generated ids)
        bndr_span :: Maybe SpanWithLabel
    bndr_span = (\RealSrcSpan
    s -> RealSrcSpan -> String -> SpanWithLabel
    SpanWithLabel RealSrcSpan
    s (OccName -> String
    occNameString (forall a. NamedThing a => a -> OccName
    getOccName Id
    bndr)))
                      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SrcSpan -> Maybe RealSrcSpan
    srcSpanToRealSrcSpan (Name -> SrcSpan
    nameSrcSpan (forall a. NamedThing a => a -> Name
    getName Id
    bndr))
      Id -> Maybe SpanWithLabel -> Maybe SpanWithLabel -> M ()
    recordStgIdPosition Id
    bndr Maybe SpanWithLabel
    best_span Maybe SpanWithLabel
    bndr_span

    collectExpr :: StgExpr -> M StgExpr
    collectExpr :: GenStgExpr 'Vanilla -> M (GenStgExpr 'Vanilla)
    collectExpr = GenStgExpr 'Vanilla -> M (GenStgExpr 'Vanilla)
    go
      where
        go :: GenStgExpr 'Vanilla -> M (GenStgExpr 'Vanilla)
    go (StgApp Id
    occ [StgArg]
    as) = forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ forall (pass :: StgPass). Id -> [StgArg] -> GenStgExpr pass
    StgApp Id
    occ [StgArg]
    as
        go (StgLit Literal
    lit) = forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ forall (pass :: StgPass). Literal -> GenStgExpr pass
    StgLit Literal
    lit
        go (StgConApp DataCon
    dc XConApp 'Vanilla
    _mn [StgArg]
    as [Type]
    tys) = do
          ConstructorNumber
    n' <- DataCon -> [StgTickish] -> M ConstructorNumber
    numberDataCon DataCon
    dc []
          forall (m :: * -> *) a. Monad m => a -> m a
    return (forall (pass :: StgPass).
    DataCon -> XConApp pass -> [StgArg] -> [Type] -> GenStgExpr pass
    StgConApp DataCon
    dc ConstructorNumber
    n' [StgArg]
    as [Type]
    tys)
        go (StgOpApp StgOp
    op [StgArg]
    as Type
    ty) = forall (m :: * -> *) a. Monad m => a -> m a
    return (forall (pass :: StgPass).
    StgOp -> [StgArg] -> Type -> GenStgExpr pass
    StgOpApp StgOp
    op [StgArg]
    as Type
    ty)
        go (StgCase GenStgExpr 'Vanilla
    scrut BinderP 'Vanilla
    bndr AltType
    ty [GenStgAlt 'Vanilla]
    alts) =
          forall (pass :: StgPass).
    GenStgExpr pass
    -> BinderP pass -> AltType -> [GenStgAlt pass] -> GenStgExpr pass
    StgCase forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> GenStgExpr 'Vanilla -> M (GenStgExpr 'Vanilla)
    collectExpr GenStgExpr 'Vanilla
    scrut forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> forall (f :: * -> *) a. Applicative f => a -> f a
    pure BinderP 'Vanilla
    bndr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> forall (f :: * -> *) a. Applicative f => a -> f a
    pure AltType
    ty forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM GenStgAlt 'Vanilla -> M (GenStgAlt 'Vanilla)
    collectAlt [GenStgAlt 'Vanilla]
    alts
        go (StgLet XLet 'Vanilla
    ext GenStgBinding 'Vanilla
    bind GenStgExpr 'Vanilla
    body) = do
            GenStgBinding 'Vanilla
    bind' <- GenStgBinding 'Vanilla -> M (GenStgBinding 'Vanilla)
    collectStgBind GenStgBinding 'Vanilla
    bind
            GenStgExpr 'Vanilla
    body' <- GenStgExpr 'Vanilla -> M (GenStgExpr 'Vanilla)
    go GenStgExpr 'Vanilla
    body
            forall (m :: * -> *) a. Monad m => a -> m a
    return (forall (pass :: StgPass).
    XLet pass
    -> GenStgBinding pass -> GenStgExpr pass -> GenStgExpr pass
    StgLet XLet 'Vanilla
    ext GenStgBinding 'Vanilla
    bind' GenStgExpr 'Vanilla
    body')
        go (StgLetNoEscape XLetNoEscape 'Vanilla
    ext GenStgBinding 'Vanilla
    bind GenStgExpr 'Vanilla
    body) = do
            GenStgBinding 'Vanilla
    bind' <- GenStgBinding 'Vanilla -> M (GenStgBinding 'Vanilla)
    collectStgBind GenStgBinding 'Vanilla
    bind
            GenStgExpr 'Vanilla
    body' <- GenStgExpr 'Vanilla -> M (GenStgExpr 'Vanilla)
    go GenStgExpr 'Vanilla
    body
            forall (m :: * -> *) a. Monad m => a -> m a
    return (forall (pass :: StgPass).
    XLetNoEscape pass
    -> GenStgBinding pass -> GenStgExpr pass -> GenStgExpr pass
    StgLetNoEscape XLetNoEscape 'Vanilla
    ext GenStgBinding 'Vanilla
    bind' GenStgExpr 'Vanilla
    body')

        go (StgTick StgTickish
    tick GenStgExpr 'Vanilla
    e) = do
           let k :: M (GenStgExpr 'Vanilla) -> M (GenStgExpr 'Vanilla)
    k = case StgTickish
    tick of
                    SourceNote RealSrcSpan
    ss String
    fp -> forall a. (RealSrcSpan, String) -> M a -> M a
    withSpan (RealSrcSpan
    ss, String
    fp)
                    StgTickish
    _ -> forall a. a -> a
    id
           GenStgExpr 'Vanilla
    e' <- M (GenStgExpr 'Vanilla) -> M (GenStgExpr 'Vanilla)
    k (GenStgExpr 'Vanilla -> M (GenStgExpr 'Vanilla)
    go GenStgExpr 'Vanilla
    e)
           forall (m :: * -> *) a. Monad m => a -> m a
    return (forall (pass :: StgPass).
    StgTickish -> GenStgExpr pass -> GenStgExpr pass
    StgTick StgTickish
    tick GenStgExpr 'Vanilla
    e')

    collectAlt :: StgAlt -> M StgAlt
    collectAlt :: GenStgAlt 'Vanilla -> M (GenStgAlt 'Vanilla)
    collectAlt (AltCon
    ac, [BinderP 'Vanilla]
    bs, GenStgExpr 'Vanilla
    e) = (AltCon
    ac, [BinderP 'Vanilla]
    bs, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> GenStgExpr 'Vanilla -> M (GenStgExpr 'Vanilla)
    collectExpr GenStgExpr 'Vanilla
    e

    -- | Try to find the best source position surrounding a 'StgExpr'. The
    -- heuristic strips ticks from the current expression until it finds one which
    -- is from the module currently being compiled. This is the same method that
    -- the DWARF information uses to give locations to info tables.
    --
    -- It is usually a better alternative than using the 'RealSrcSpan' which is carefully
    -- propagated downwards by 'withSpan'. It's "quick" because it works only using immediate context rather
    -- than looking at the parent context like 'withSpan'
    quickSourcePos :: FastString -> StgExpr -> Maybe SpanWithLabel
    quickSourcePos :: FastString -> GenStgExpr 'Vanilla -> Maybe SpanWithLabel
    quickSourcePos FastString
    cur_mod (StgTick (SourceNote RealSrcSpan
    ss String
    m) GenStgExpr 'Vanilla
    e)
      | RealSrcSpan -> FastString
    srcSpanFile RealSrcSpan
    ss forall a. Eq a => a -> a -> Bool
    == FastString
    cur_mod = forall a. a -> Maybe a
    Just (RealSrcSpan -> String -> SpanWithLabel
    SpanWithLabel RealSrcSpan
    ss String
    m)
      | Bool
    otherwise = FastString -> GenStgExpr 'Vanilla -> Maybe SpanWithLabel
    quickSourcePos FastString
    cur_mod GenStgExpr 'Vanilla
    e
    quickSourcePos FastString
    _ GenStgExpr 'Vanilla
    _ = forall a. Maybe a
    Nothing

    recordStgIdPosition :: Id -> Maybe SpanWithLabel -> Maybe SpanWithLabel -> M ()
    recordStgIdPosition :: Id -> Maybe SpanWithLabel -> Maybe SpanWithLabel -> M ()
    recordStgIdPosition Id
    id Maybe SpanWithLabel
    best_span Maybe SpanWithLabel
    ss = do
      DynFlags
    dflags <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks R -> DynFlags
    rDynFlags
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_InfoTableMap DynFlags
    dflags) forall a b. (a -> b) -> a -> b
    $ do
        Maybe SpanWithLabel
    cc <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks R -> Maybe SpanWithLabel
    rSpan
        --Useful for debugging why a certain Id gets given a certain span
        --pprTraceM "recordStgIdPosition" (ppr id $$ ppr cc $$ ppr best_span $$ ppr ss)
        let mbspan :: Maybe (RealSrcSpan, String)
    mbspan = (\(SpanWithLabel RealSrcSpan
    rss String
    d) -> (RealSrcSpan
    rss, String
    d)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Maybe SpanWithLabel
    best_span forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Maybe SpanWithLabel
    cc forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Maybe SpanWithLabel
    ss)
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift forall a b. (a -> b) -> a -> b
    $ forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
    modify (\InfoTableProvMap
    env -> InfoTableProvMap
    env { provClosure :: ClosureMap
    provClosure = forall k a. Uniquable k => UniqMap k a -> k -> a -> UniqMap k a
    addToUniqMap (InfoTableProvMap -> ClosureMap
    provClosure InfoTableProvMap
    env) (Id -> Name
    idName Id
    id) (Id -> Type
    idType Id
    id, Maybe (RealSrcSpan, String)
    mbspan) })

    numberDataCon :: DataCon -> [StgTickish] -> M ConstructorNumber
    -- Unboxed tuples and sums do not allocate so they
    -- have no info tables.
    numberDataCon :: DataCon -> [StgTickish] -> M ConstructorNumber
    numberDataCon DataCon
    dc [StgTickish]
    _ | DataCon -> Bool
    isUnboxedTupleDataCon DataCon
    dc = forall (m :: * -> *) a. Monad m => a -> m a
    return ConstructorNumber
    NoNumber
    numberDataCon DataCon
    dc [StgTickish]
    _ | DataCon -> Bool
    isUnboxedSumDataCon DataCon
    dc = forall (m :: * -> *) a. Monad m => a -> m a
    return ConstructorNumber
    NoNumber
    numberDataCon DataCon
    dc [StgTickish]
    ts = do
      DynFlags
    dflags <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks R -> DynFlags
    rDynFlags
      if Bool -> Bool
    not (GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_DistinctConstructorTables DynFlags
    dflags) then forall (m :: * -> *) a. Monad m => a -> m a
    return ConstructorNumber
    NoNumber else do
        InfoTableProvMap
    env <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift forall (m :: * -> *) s. Monad m => StateT s m s
    get
        Maybe SpanWithLabel
    mcc <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks R -> Maybe SpanWithLabel
    rSpan
        let mbest_span :: Maybe (RealSrcSpan, String)
    mbest_span = (\(SpanWithLabel RealSrcSpan
    rss String
    l) -> (RealSrcSpan
    rss, String
    l)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([StgTickish] -> Maybe SpanWithLabel
    selectTick [StgTickish]
    ts forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Maybe SpanWithLabel
    mcc)
        let dcMap' :: UniqMap DataCon (NonEmpty (Int, Maybe (RealSrcSpan, String)))
    dcMap' = forall k a.
    Uniquable k =>
    (Maybe a -> Maybe a) -> UniqMap k a -> k -> UniqMap k a
    alterUniqMap (forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (forall a. a -> Maybe a
    Just ((Int
    0, Maybe (RealSrcSpan, String)
    mbest_span) forall a. a -> [a] -> NonEmpty a
    :| [] ))
                            (\xs :: NonEmpty (Int, Maybe (RealSrcSpan, String))
    xs@((Int
    k, Maybe (RealSrcSpan, String)
    _):|[(Int, Maybe (RealSrcSpan, String))]
    _) -> forall a. a -> Maybe a
    Just ((Int
    k forall a. Num a => a -> a -> a
    + Int
    1, Maybe (RealSrcSpan, String)
    mbest_span) forall a. a -> NonEmpty a -> NonEmpty a
    `NE.cons` NonEmpty (Int, Maybe (RealSrcSpan, String))
    xs))) (InfoTableProvMap
    -> UniqMap DataCon (NonEmpty (Int, Maybe (RealSrcSpan, String)))
    provDC InfoTableProvMap
    env) DataCon
    dc
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift forall a b. (a -> b) -> a -> b
    $ forall (m :: * -> *) s. Monad m => s -> StateT s m ()
    put (InfoTableProvMap
    env { provDC :: UniqMap DataCon (NonEmpty (Int, Maybe (RealSrcSpan, String)))
    provDC = UniqMap DataCon (NonEmpty (Int, Maybe (RealSrcSpan, String)))
    dcMap' })
        let r :: Maybe (NonEmpty (Int, Maybe (RealSrcSpan, String)))
    r = forall k a. Uniquable k => UniqMap k a -> k -> Maybe a
    lookupUniqMap UniqMap DataCon (NonEmpty (Int, Maybe (RealSrcSpan, String)))
    dcMap' DataCon
    dc
        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ case Maybe (NonEmpty (Int, Maybe (RealSrcSpan, String)))
    r of
          Maybe (NonEmpty (Int, Maybe (RealSrcSpan, String)))
    Nothing -> ConstructorNumber
    NoNumber
          Just NonEmpty (Int, Maybe (RealSrcSpan, String))
    res -> Int -> ConstructorNumber
    Numbered (forall a b. (a, b) -> a
    fst (forall a. NonEmpty a -> a
    NE.head NonEmpty (Int, Maybe (RealSrcSpan, String))
    res))

    selectTick :: [StgTickish] -> Maybe SpanWithLabel
    selectTick :: [StgTickish] -> Maybe SpanWithLabel
    selectTick [] = forall a. Maybe a
    Nothing
    selectTick (SourceNote RealSrcSpan
    rss String
    d : [StgTickish]
    ts ) = [StgTickish] -> Maybe SpanWithLabel
    selectTick [StgTickish]
    ts forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> forall a. a -> Maybe a
    Just (RealSrcSpan -> String -> SpanWithLabel
    SpanWithLabel RealSrcSpan
    rss String
    d)
    selectTick (StgTickish
    _:[StgTickish]
    ts) = [StgTickish] -> Maybe SpanWithLabel
    selectTick [StgTickish]
    ts

    {-
    Note [Mapping Info Tables to Source Positions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    This note describes what the `-finfo-table-map` flag achieves.

    When debugging memory issues it is very useful to be able to map a specific closure
    to a position in the source. The prime example is being able to map a THUNK to
    a specific place in the source program, the mapping is usually quite precise because
    a fresh info table is created for each distinct THUNK.

    There are three parts to the implementation

    1. In GHC.Stg.Debug, the SourceNote information is used in order to give a source location to
    some specific closures.
    2. In StgToCmm, the actually used info tables are recorded in an IORef, this
    is important as it's hard to predict beforehand what code generation will do
    and which ids will end up in the generated program.
    3. During code generation, a mapping from the info table to the statically
    determined location is emitted which can then be queried at runtime by
    various tools.

    -- Giving Source Locations to Closures

    At the moment thunk and constructor closures are added to the map. This information
    is collected in the `InfoTableProvMap` which provides a mapping from:

    1. Data constructors to a list of where they are used.
    2. `Name`s and where they originate from.

    During the CoreToStg phase, this map is populated whenever something is turned into
    a StgRhsClosure or an StgConApp. The current source position is recorded
    depending on the location indicated by the surrounding SourceNote.

    The functions which add information to the map are `recordStgIdPosition` and
    `numberDataCon`.

    When the -fdistinct-constructor-tables` flag is turned on then every
    usage of a data constructor gets its own distinct info table. This is orchestrated
    in `collectExpr` where an incrementing number is used to distinguish each
    occurrence of a data constructor.

    -- StgToCmm

    The info tables which are actually used in the generated program are recorded during the
    conversion from STG to Cmm. The used info tables are recorded in the `emitProc` function.
    All the used info tables are recorded in the `cgs_used_info` field. This step
    is necessary because when the information about names is collected in the previous
    phase it's unpredictable about which names will end up needing info tables. If
    you don't record which ones are actually used then you end up generating code
    which references info tables which don't exist.

    -- Code Generation

    The output of these two phases is combined together during code generation.
    A C stub is generated which
    creates the static map from info table pointer to the information about where that
    info table was created from. This is created by `ipInitCode` in the same manner as a
    C stub is generated for cost centres.

    This information can be consumed in two ways.

    1. The complete mapping is emitted into the eventlog so that external tools such
    as eventlog2html can use the information with the heap profile by info table mode.
    2. The `lookupIPE` function can be used via the `whereFrom#` primop to introspect
    information about a closure in a running Haskell program.

    Note [Distinct Info Tables for Constructors]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    In the old times, each usage of a data constructor used the same info table.
    This made it impossible to distinguish which actual usuage of a data constructor was
    contributing primarily to the allocation in a program. Using the `-fdistinct-info-tables` flag you
    can cause code generation to generate a distinct info table for each usage of
    a constructor. Then, when inspecting the heap you can see precisely which usage of a constructor
    was responsible for each allocation.

    -}