    {-# LANGUAGE GADTs, RecordWildCards,
        NondecreasingIndentation,
        OverloadedStrings, LambdaCase #-}
    {-# LANGUAGE DerivingStrategies #-}
    {-# LANGUAGE UndecidableInstances #-}

    module GHC.Cmm.Info.Build
      ( CAFSet, CAFEnv, cafAnal, cafAnalData
      , doSRTs, ModuleSRTInfo (..), emptySRT
      , SRTMap, srtMapNonCAFs
      ) where

    import GHC.Prelude hiding (succ)

    import GHC.Platform
    import GHC.Platform.Profile

    import GHC.Types.Id
    import GHC.Types.Id.Info
    import GHC.Cmm.BlockId
    import GHC.Cmm.Config
    import GHC.Cmm.Dataflow.Block
    import GHC.Cmm.Dataflow.Graph
    import GHC.Cmm.Dataflow.Label
    import GHC.Cmm.Dataflow
    import GHC.Unit.Module
    import GHC.Data.Graph.Directed
    import GHC.Cmm.CLabel
    import GHC.Cmm
    import GHC.Cmm.Utils
    import GHC.Data.Maybe
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Runtime.Heap.Layout
    import GHC.Types.Unique.Supply
    import GHC.Types.CostCentre
    import GHC.StgToCmm.Heap

    import Control.Monad
    import Data.Map.Strict (Map)
    import qualified Data.Map.Strict as Map
    import Data.Set (Set)
    import qualified Data.Set as Set
    import Control.Monad.Trans.State
    import Control.Monad.Trans.Class
    import Data.List (unzip4)

    import GHC.Types.Name.Set

    {- Note [SRTs]
       ~~~~~~~~~~~
    Static Reference Tables (SRTs) are the mechanism by which the garbage collector
    can determine the live CAFs in the program. An SRT is a static table associated
    with a CAFfy closure which record which CAFfy objects are reachable from
    the closure's code.

    Representation
    ^^^^^^^^^^^^^^

    +------+
    | info |
    |      |     +-----+---+---+---+
    |   -------->|SRT_2| | | | | 0 |
    |------|     +-----+-|-+-|-+---+
    |      |             |   |
    | code |             |   |
    |      |             v   v

    An SRT is simply an object in the program's data segment. It has the
    same representation as a static constructor.  There are 16
    pre-compiled SRT info tables: stg_SRT_1_info, .. stg_SRT_16_info,
    representing SRT objects with 1-16 pointers, respectively.

    The entries of an SRT object point to static closures, which are either
    - FUN_STATIC, THUNK_STATIC or CONSTR
    - Another SRT (actually just a CONSTR)

    The final field of the SRT is the static link field, used by the
    garbage collector to chain together static closures that it visits and
    to determine whether a static closure has been visited or not. (see
    Note [STATIC_LINK fields])

    By traversing the transitive closure of an SRT, the GC will reach all
    of the CAFs that are reachable from the code associated with this SRT.

    If we need to create an SRT with more than 16 entries, we build a
    chain of SRT objects with all but the last having 16 entries.

    +-----+---+- -+---+---+
    |SRT16| | |   | | | 0 |
    +-----+-|-+- -+-|-+---+
            |       |
            v       v
                  +----+---+---+---+
                  |SRT2| | | | | 0 |
                  +----+-|-+-|-+---+
                         |   |
                         |   |
                         v   v

    Referring to an SRT from the info table
    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

    The following things have SRTs:

    - Static functions (FUN)
    - Static thunks (THUNK), ie. CAFs
    - Continuations (RET_SMALL, etc.)

    In each case, the info table points to the SRT, if there is one.

    - info->srt is 0 if there's no SRT
    - otherwise, there are three ways which we may encode the location of the SRT in
      the info table, described below.

    USE_SRT_POINTER
    ---------------
    Most general implementation. Can always be used, but other ways are more efficient.

    - info->srt is a pointer

    We encode an **absolute pointer** to the SRT in info->srt. e.g. for a FUN
    with an SRT:

    StgInfoTable          +------+
      info->layout.ptrs   | ...  |
      info->layout.nptrs  | ...  |
      info->srt           |  ------------> pointer to SRT object
      info->type          | ...  |
                          |------|

    USE_SRT_OFFSET
    --------------
    Requires:
      - tables-next-to-code enabled

    In this case we use the info->srt to encode whether or not there is an SRT and
    if so encode the offset to its location in info->f.srt_offset:

    - info->srt is a half-word
    - info->f.srt_offset is a 32-bit int
    - info->srt is 0 if there's no SRT, otherwise,
    - info->srt == 1 and info->f.srt_offset is a offset to the SRT, relative to the
    field address itself

    e.g. for a FUN with an SRT:

    StgFunInfoTable       +------+
      info->f.srt_offset  |  ------------> offset to SRT object
    StgInfoTable          +------+
      info->layout.ptrs   | ...  |
      info->layout.nptrs  | ...  |
      info->srt           |  1   |
      info->type          | ...  |
                          |------|

    USE_INLINE_SRT_FIELD
    --------------------
    Requires:
      - tables-next-to-code enabled
      - 64-bit architecture
      - small memory model

    We optimise the info table representation further.  The offset to the SRT can
    be stored in 32 bits (all code lives within a 2GB region in x86_64's small
    memory model), so we can save a word in the info table by storing the
    srt_offset in the srt field, which is half a word.

    - info->srt is a half-word
    - info->srt is 0 if there's no SRT, otherwise:
    - info->srt is an offset from the info pointer to the SRT object

    StgInfoTable          +------+
      info->layout.ptrs   |      |
      info->layout.nptrs  |      |
      info->srt           |  ------------> offset to SRT object
                          |------|

    EXAMPLE
    ^^^^^^^

    f = \x. ... g ...
      where
        g = \y. ... h ... c1 ...
        h = \z. ... c2 ...

    c1 & c2 are CAFs

    g and h are local functions, but they have no static closures.  When
    we generate code for f, we start with a CmmGroup of four CmmDecls:

       [ f_closure, f_entry, g_entry, h_entry ]

    we process each CmmDecl separately in cpsTop, giving us a list of
    CmmDecls. e.g. for f_entry, we might end up with

       [ f_entry, f1_ret, f2_proc ]

    where f1_ret is a return point, and f2_proc is a proc-point.  We have
    a CAFSet for each of these CmmDecls, let's suppose they are

       [ f_entry{g_info}, f1_ret{g_info}, f2_proc{} ]
       [ g_entry{h_info, c1_closure} ]
       [ h_entry{c2_closure} ]

    Next, we make an SRT for each of these functions:

      f_srt : [g_info]
      g_srt : [h_info, c1_closure]
      h_srt : [c2_closure]

    Now, for g_info and h_info, we want to refer to the SRTs for g and h
    respectively, which we'll label g_srt and h_srt:

      f_srt : [g_srt]
      g_srt : [h_srt, c1_closure]
      h_srt : [c2_closure]

    Now, when an SRT has a single entry, we don't actually generate an SRT
    closure for it, instead we just replace references to it with its
    single element.  So, since h_srt == c2_closure, we have

      f_srt : [g_srt]
      g_srt : [c2_closure, c1_closure]
      h_srt : [c2_closure]

    and the only SRT closure we generate is

      g_srt = SRT_2 [c2_closure, c1_closure]

    Algorithm
    ^^^^^^^^^

    0. let srtMap :: Map CAFfyLabel (Maybe SRTEntry) = {}
       Maps closures to their SRT entries (i.e. how they appear in a SRT payload)

    1. Start with decls :: [CmmDecl]. This corresponds to an SCC of bindings in STG
       after code-generation.

    2. CPS-convert each CmmDecl (GHC.Cmm.Pipeline.cpsTop), resulting in a list
       [CmmDecl]. There might be multiple CmmDecls in the result, due to proc-point
       splitting.

    3. In cpsTop, *before* proc-point splitting, when we still have a single
       CmmDecl, we do cafAnal for procs:

       * cafAnal performs a backwards analysis on the code blocks

       * For each labelled block, the analysis produces a CAFSet (= Set CAFfyLabel),
         representing all the CAFfyLabels reachable from this label.

       * A label is added to the set if it refers to a FUN, THUNK, or RET,
         and its CafInfo /= NoCafRefs.
         (NB. all CafInfo for Ids in the current module should be initialised to
         MayHaveCafRefs)

       * The result is CAFEnv = LabelMap CAFSet

       (Why *before* proc-point splitting? Because the analysis needs to propagate
       information across branches, and proc-point splitting turns branches into
       CmmCalls to top-level CmmDecls.  The analysis would fail to find all the
       references to CAFFY labels if we did it after proc-point splitting.)

       For static data, cafAnalData simply returns set of all labels that refer to a
       FUN, THUNK, and RET whose CafInfos /= NoCafRefs.

    4. The result of cpsTop is (CAFEnv, [CmmDecl]) for procs and (CAFSet, CmmDecl)
       for static data. So after `mapM cpsTop decls` we have
       [Either (CAFEnv, [CmmDecl]) (CAFSet, CmmDecl)]

    5. For procs concat the decls and union the CAFEnvs to get (CAFEnv, [CmmDecl])

    6. For static data generate a Map CLabel CAFSet (maps static data to their CAFSets)

    7. Dependency-analyse the decls using CAFEnv and CAFSets, giving us SCC CAFfyLabel

    8. For each SCC in dependency order
       - Let lbls :: [CAFfyLabel] be the non-recursive labels in this SCC
       - Apply CAFEnv to each label and concat the result :: [CAFfyLabel]
       - For each CAFfyLabel in the set apply srtMap (and ignore Nothing) to get
         srt :: [SRTEntry]
       - Make a label for this SRT, call it l
       - If the SRT is not empty (i.e. the group is CAFFY) add FUN_STATICs in the
         group to the SRT (see Note [Invalid optimisation: shortcutting])
       - Add to srtMap: lbls -> if null srt then Nothing else Just l

    9. At the end, update the IdInfo for every top-level binding x:
       if srtMap x == Nothing, then the binding is non-CAFFY, otherwise it is
       CAFFY.

    Optimisations
    ^^^^^^^^^^^^^

    To reduce the code size overhead and the cost of traversing SRTs in
    the GC, we want to simplify SRTs where possible. We therefore apply
    the following optimisations.  Each has a [keyword]; search for the
    keyword in the code below to see where the optimisation is
    implemented.

    1. [Inline] we never create an SRT with a single entry, instead we
       point to the single entry directly from the info table.

       i.e. instead of

        +------+
        | info |
        |      |     +-----+---+---+
        |   -------->|SRT_1| | | 0 |
        |------|     +-----+-|-+---+
        |      |             |
        | code |             |
        |      |             v
                             C

       we can point directly to the closure:

        +------+
        | info |
        |      |
        |   -------->C
        |------|
        |      |
        | code |
        |      |

       Furthermore, the SRT for any code that refers to this info table
       can point directly to C.

       The exception to this is when we're doing dynamic linking. In that
       case, if the closure is not locally defined then we can't point to
       it directly from the info table, because this is the text section
       which cannot contain runtime relocations. In this case we skip this
       optimisation and generate the singleton SRT, because SRTs are in the
       data section and *can* have relocatable references.

    2. [FUN] A static function closure can also be an SRT, we simply put
       the SRT entries as fields in the static closure.  This makes a lot
       of sense: the static references are just like the free variables of
       the FUN closure.

       i.e. instead of

       f_closure:
       +-----+---+
       |  |  | 0 |
       +- |--+---+
          |            +------+
          |            | info |     f_srt:
          |            |      |     +-----+---+---+---+
          |            |   -------->|SRT_2| | | | + 0 |
          `----------->|------|     +-----+-|-+-|-+---+
                       |      |             |   |
                       | code |             |   |
                       |      |             v   v

       We can generate:

       f_closure:
       +-----+---+---+---+
       |  |  | | | | | 0 |
       +- |--+-|-+-|-+---+
          |    |   |   +------+
          |    v   v   | info |
          |            |      |
          |            |   0  |
          `----------->|------|
                       |      |
                       | code |
                       |      |

       (note: we can't do this for THUNKs, because the thunk gets
       overwritten when it is entered, so we wouldn't be able to share
       this SRT with other info tables that want to refer to it (see
       [Common] below). FUNs are immutable so don't have this problem.)

    3. [Common] Identical SRTs can be commoned up.

    4. [Filter] If an SRT A refers to an SRT B and a closure C, and B also
       refers to C (perhaps transitively), then we can omit the reference
       to C from A.

    Note that there are many other optimisations that we could do, but
    aren't implemented. In general, we could omit any reference from an
    SRT if everything reachable from it is also reachable from the other
    fields in the SRT. Our [Filter] optimisation is a special case of
    this.

    Another opportunity we don't exploit is this:

    A = {X,Y,Z}
    B = {Y,Z}
    C = {X,B}

    Here we could use C = {A} and therefore [Inline] C = A.
    -}

    -- ---------------------------------------------------------------------
    {-
    Note [No static object resurrection]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The "static flag" mechanism (see Note [STATIC_LINK fields] in smStorage.h) that
    the GC uses to track liveness of static objects assumes that unreachable
    objects will never become reachable again (i.e. are never "resurrected").
    Breaking this assumption can result in extremely subtle GC soundness issues
    (e.g. #15544, #20959).

    Guaranteeing that this assumption is not violated requires that all CAFfy
    static objects reachable from the object's code are reachable from its SRT.  In
    the past we have gotten this wrong in a few ways:

     * shortcutting references to FUN_STATICs to instead point to the FUN_STATIC's
       SRT. This lead to #15544 and is described in more detail in Note [Invalid
       optimisation: shortcutting].

     * omitting references to static data constructor applications. This previously
       happened due to an oversight (#20959): when generating an SRT for a
       recursive group we would drop references to the CAFfy static data
       constructors.

    To see why we cannot allow object resurrection, see the examples in the
    above-mentioned Notes.

    If a static closure definitely does not transitively refer to any CAFs, then it
    *may* be advertised as not-CAFfy in the interface file and consequently *may*
    be omitted from SRTs. Regardless of whether the closure is advertised as CAFfy
    or non-CAFfy, its STATIC_LINK field *must* be set to 3, so that it never
    appears on the static closure list.
    -}

    {-
    Note [Invalid optimisation: shortcutting]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    You might think that if we have something like

    A's SRT = {B}
    B's SRT = {X}

    that we could replace the reference to B in A's SRT with X.

    A's SRT = {X}
    B's SRT = {X}

    and thereby perhaps save a little work at runtime, because we don't
    have to visit B.

    But this is NOT valid.

    Consider these cases:

    0. B can't be a constructor, because constructors don't have SRTs

    1. B is a CAF. This is the easy one. Obviously we want A's SRT to
       point to B, so that it keeps B alive.

    2. B is a function.  This is the tricky one. The reason we can't
       shortcut in this case is that we aren't allowed to resurrect static
       objects for the reason described in Note [No static object resurrection].
       We noticed this in #15544.

    The particular case that cropped up when we tried this in #15544 was:

    - A is a thunk
    - B is a static function
    - X is a CAF
    - suppose we GC when A is alive, and B is not otherwise reachable.
    - B is "collected", meaning that it doesn't make it onto the static
      objects list during this GC, but nothing bad happens yet.
    - Next, suppose we enter A, and then call B. (remember that A refers to B)
      At the entry point to B, we GC. This puts B on the stack, as part of the
      RET_FUN stack frame that gets pushed when we GC at a function entry point.
    - This GC will now reach B
    - But because B was previous "collected", it breaks the assumption
      that static objects are never resurrected. See Note [STATIC_LINK
      fields] in rts/sm/Storage.h for why this is bad.
    - In practice, the GC thinks that B has already been visited, and so
      doesn't visit X, and catastrophe ensues.

    Note [Ticky labels in SRT analysis]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Raw Cmm data (CmmStaticsRaw) can't contain pointers so they're considered
    non-CAFFY in SRT analysis and we update the SRTMap mapping them to `Nothing`
    (meaning they're not CAFFY).

    However when building with -ticky we generate ticky CLabels using the function's
    `Name`. For example, if we have a top-level function `sat_s1rQ`, in a ticky
    build we get two IdLabels using the name `sat_s1rQ`:

    - For the function itself: IdLabel sat_s1rQ ... Entry
    - For the ticky counter: IdLabel sat_s1rQ ... RednCounts

    In these cases we really want to use the function definition for the SRT
    analysis of this Name, because that's what we export for this Name -- ticky
    counters are not exported. So we ignore ticky counters in SRT analysis (which
    are never CAFFY and never exported).

    Not doing this caused #17947 where we analysed the function first mapped the
    name to CAFFY. We then saw the ticky constructor, and because it has the same
    Name as the function and is not CAFFY we overrode the CafInfo of the name as
    non-CAFFY.
    -}

    -- ---------------------------------------------------------------------
    -- Label types

    -- |
    -- The label of a CAFfy thing.
    --
    -- Labels that come from 'cafAnal' can be:
    --   - @_closure@ labels for static functions, static data constructor
    --     applications, or static thunks
    --   - @_info@ labels for dynamic functions, thunks, or continuations
    --   - @_entry@ labels for functions or thunks
    --
    -- Meanwhile the labels on top-level blocks are @_entry@ labels.
    --
    -- To put everything in the same namespace we convert all labels to
    -- closure labels using 'toClosureLbl'.  Note that some of these
    -- labels will not actually exist; that's ok because we're going to
    -- map them to SRTEntry later, which ranges over labels that do exist.
    --
    newtype CAFfyLabel = CAFfyLabel CLabel
      deriving (CAFfyLabel -> CAFfyLabel -> Bool
    (CAFfyLabel -> CAFfyLabel -> Bool)
    -> (CAFfyLabel -> CAFfyLabel -> Bool) -> Eq CAFfyLabel
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CAFfyLabel -> CAFfyLabel -> Bool
    == :: CAFfyLabel -> CAFfyLabel -> Bool
    $c/= :: CAFfyLabel -> CAFfyLabel -> Bool
    /= :: CAFfyLabel -> CAFfyLabel -> Bool
    Eq,Eq CAFfyLabel
    Eq CAFfyLabel =>
    (CAFfyLabel -> CAFfyLabel -> Ordering)
    -> (CAFfyLabel -> CAFfyLabel -> Bool)
    -> (CAFfyLabel -> CAFfyLabel -> Bool)
    -> (CAFfyLabel -> CAFfyLabel -> Bool)
    -> (CAFfyLabel -> CAFfyLabel -> Bool)
    -> (CAFfyLabel -> CAFfyLabel -> CAFfyLabel)
    -> (CAFfyLabel -> CAFfyLabel -> CAFfyLabel)
    -> Ord CAFfyLabel
    CAFfyLabel -> CAFfyLabel -> Bool
    CAFfyLabel -> CAFfyLabel -> Ordering
    CAFfyLabel -> CAFfyLabel -> CAFfyLabel
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: CAFfyLabel -> CAFfyLabel -> Ordering
    compare :: CAFfyLabel -> CAFfyLabel -> Ordering
    $c< :: CAFfyLabel -> CAFfyLabel -> Bool
    < :: CAFfyLabel -> CAFfyLabel -> Bool
    $c<= :: CAFfyLabel -> CAFfyLabel -> Bool
    <= :: CAFfyLabel -> CAFfyLabel -> Bool
    $c> :: CAFfyLabel -> CAFfyLabel -> Bool
    > :: CAFfyLabel -> CAFfyLabel -> Bool
    $c>= :: CAFfyLabel -> CAFfyLabel -> Bool
    >= :: CAFfyLabel -> CAFfyLabel -> Bool
    $cmax :: CAFfyLabel -> CAFfyLabel -> CAFfyLabel
    max :: CAFfyLabel -> CAFfyLabel -> CAFfyLabel
    $cmin :: CAFfyLabel -> CAFfyLabel -> CAFfyLabel
    min :: CAFfyLabel -> CAFfyLabel -> CAFfyLabel
    Ord)

    deriving newtype instance OutputableP env CLabel => OutputableP env CAFfyLabel

    type CAFSet = Set CAFfyLabel
    type CAFEnv = LabelMap CAFSet

    -- | Records the CAFfy references of a set of static data decls.
    type DataCAFEnv = Map CLabel CAFSet

    mkCAFfyLabel :: Platform -> CLabel -> CAFfyLabel
    mkCAFfyLabel :: Platform -> CLabel -> CAFfyLabel
    mkCAFfyLabel Platform
    platform CLabel
    lbl = CLabel -> CAFfyLabel
    CAFfyLabel (Platform -> CLabel -> CLabel
    toClosureLbl Platform
    platform CLabel
    lbl)

    -- This is a label that we can put in an SRT.  It *must* be a closure label,
    -- pointing to either a @FUN_STATIC@, @THUNK_STATIC@, or @CONSTR@.
    newtype SRTEntry = SRTEntry CLabel
      deriving (SRTEntry -> SRTEntry -> Bool
    (SRTEntry -> SRTEntry -> Bool)
    -> (SRTEntry -> SRTEntry -> Bool) -> Eq SRTEntry
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: SRTEntry -> SRTEntry -> Bool
    == :: SRTEntry -> SRTEntry -> Bool
    $c/= :: SRTEntry -> SRTEntry -> Bool
    /= :: SRTEntry -> SRTEntry -> Bool
    Eq, Eq SRTEntry
    Eq SRTEntry =>
    (SRTEntry -> SRTEntry -> Ordering)
    -> (SRTEntry -> SRTEntry -> Bool)
    -> (SRTEntry -> SRTEntry -> Bool)
    -> (SRTEntry -> SRTEntry -> Bool)
    -> (SRTEntry -> SRTEntry -> Bool)
    -> (SRTEntry -> SRTEntry -> SRTEntry)
    -> (SRTEntry -> SRTEntry -> SRTEntry)
    -> Ord SRTEntry
    SRTEntry -> SRTEntry -> Bool
    SRTEntry -> SRTEntry -> Ordering
    SRTEntry -> SRTEntry -> SRTEntry
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: SRTEntry -> SRTEntry -> Ordering
    compare :: SRTEntry -> SRTEntry -> Ordering
    $c< :: SRTEntry -> SRTEntry -> Bool
    < :: SRTEntry -> SRTEntry -> Bool
    $c<= :: SRTEntry -> SRTEntry -> Bool
    <= :: SRTEntry -> SRTEntry -> Bool
    $c> :: SRTEntry -> SRTEntry -> Bool
    > :: SRTEntry -> SRTEntry -> Bool
    $c>= :: SRTEntry -> SRTEntry -> Bool
    >= :: SRTEntry -> SRTEntry -> Bool
    $cmax :: SRTEntry -> SRTEntry -> SRTEntry
    max :: SRTEntry -> SRTEntry -> SRTEntry
    $cmin :: SRTEntry -> SRTEntry -> SRTEntry
    min :: SRTEntry -> SRTEntry -> SRTEntry
    Ord)

    deriving newtype instance OutputableP env CLabel => OutputableP env SRTEntry

    -- ---------------------------------------------------------------------
    -- CAF analysis

    addCafLabel :: Platform -> CLabel -> CAFSet -> CAFSet
    addCafLabel :: Platform -> CLabel -> Set CAFfyLabel -> Set CAFfyLabel
    addCafLabel Platform
    platform CLabel
    l Set CAFfyLabel
    s
      | Just Name
    _ <- CLabel -> Maybe Name
    hasHaskellName CLabel
    l
      , let caf_label :: CAFfyLabel
    caf_label = Platform -> CLabel -> CAFfyLabel
    mkCAFfyLabel Platform
    platform CLabel
    l
        -- For imported Ids hasCAF will have accurate CafInfo
        -- Locals are initialized as CAFFY. We turn labels with empty SRTs into
        -- non-CAFFYs in doSRTs
      , CLabel -> Bool
    hasCAF CLabel
    l
      = CAFfyLabel -> Set CAFfyLabel -> Set CAFfyLabel
    forall a. Ord a => a -> Set a -> Set a
    Set.insert CAFfyLabel
    caf_label Set CAFfyLabel
    s
      | Bool
    otherwise
      = Set CAFfyLabel
    s

    -- | Collect possible CAFfy references from a 'CmmData' decl.
    cafAnalData
      :: Platform
      -> CmmStatics
      -> CAFSet
    cafAnalData :: Platform -> GenCmmStatics 'False -> Set CAFfyLabel
    cafAnalData Platform
    platform GenCmmStatics 'False
    st = case GenCmmStatics 'False
    st of
       CmmStaticsRaw CLabel
    _lbl [CmmStatic]
    _data           -> Set CAFfyLabel
    forall a. Set a
    Set.empty
       CmmStatics CLabel
    _lbl CmmInfoTable
    _itbl CostCentreStack
    _ccs [CmmLit]
    payload [CmmLit]
    _extras ->
           (Set CAFfyLabel -> CmmLit -> Set CAFfyLabel)
    -> Set CAFfyLabel -> [CmmLit] -> Set CAFfyLabel
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Set CAFfyLabel -> CmmLit -> Set CAFfyLabel
    analyzeStatic Set CAFfyLabel
    forall a. Set a
    Set.empty [CmmLit]
    payload
         where
           analyzeStatic :: Set CAFfyLabel -> CmmLit -> Set CAFfyLabel
    analyzeStatic Set CAFfyLabel
    s CmmLit
    lit =
             case CmmLit
    lit of
               CmmLabel CLabel
    c -> Platform -> CLabel -> Set CAFfyLabel -> Set CAFfyLabel
    addCafLabel Platform
    platform CLabel
    c Set CAFfyLabel
    s
               CmmLabelOff CLabel
    c WordOff
    _ -> Platform -> CLabel -> Set CAFfyLabel -> Set CAFfyLabel
    addCafLabel Platform
    platform CLabel
    c Set CAFfyLabel
    s
               CmmLabelDiffOff CLabel
    c1 CLabel
    c2 WordOff
    _ Width
    _ -> Platform -> CLabel -> Set CAFfyLabel -> Set CAFfyLabel
    addCafLabel Platform
    platform CLabel
    c1 (Set CAFfyLabel -> Set CAFfyLabel)
    -> Set CAFfyLabel -> Set CAFfyLabel
    forall a b. (a -> b) -> a -> b
    $! Platform -> CLabel -> Set CAFfyLabel -> Set CAFfyLabel
    addCafLabel Platform
    platform CLabel
    c2 Set CAFfyLabel
    s
               CmmLit
    _ -> Set CAFfyLabel
    s

    -- |
    -- For each code block:
    --   - collect the references reachable from this code block to FUN,
    --     THUNK or RET labels for which @hasCAF == True@
    --
    -- This gives us a 'CAFEnv': a mapping from code block to sets of labels
    --
    cafAnal
      :: Platform
      -> LabelSet   -- ^ The blocks representing continuations, ie. those
                    -- that will get RET info tables.  These labels will
                    -- get their own SRTs, so we don't aggregate CAFs from
                    -- references to these labels, we just use the label.
      -> CLabel     -- ^ The top label of the proc
      -> CmmGraph
      -> CAFEnv
    cafAnal :: Platform -> LabelSet -> CLabel -> GenCmmGraph CmmNode -> CAFEnv
    cafAnal Platform
    platform LabelSet
    contLbls CLabel
    topLbl GenCmmGraph CmmNode
    cmmGraph =
      DataflowLattice (Set CAFfyLabel)
    -> TransferFun' CmmNode (Set CAFfyLabel)
    -> GenCmmGraph CmmNode
    -> CAFEnv
    -> CAFEnv
    forall (node :: Extensibility -> Extensibility -> *) f.
    NonLocal node =>
    DataflowLattice f
    -> TransferFun' node f
    -> GenCmmGraph node
    -> FactBase f
    -> FactBase f
    analyzeCmmBwd DataflowLattice (Set CAFfyLabel)
    cafLattice
        (Platform
    -> LabelSet
    -> BlockId
    -> CLabel
    -> TransferFun' CmmNode (Set CAFfyLabel)
    cafTransfers Platform
    platform LabelSet
    contLbls (GenCmmGraph CmmNode -> BlockId
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> BlockId
    g_entry GenCmmGraph CmmNode
    cmmGraph) CLabel
    topLbl) GenCmmGraph CmmNode
    cmmGraph CAFEnv
    forall v. LabelMap v
    mapEmpty

    cafLattice :: DataflowLattice CAFSet
    cafLattice :: DataflowLattice (Set CAFfyLabel)
    cafLattice = Set CAFfyLabel
    -> JoinFun (Set CAFfyLabel) -> DataflowLattice (Set CAFfyLabel)
    forall a. a -> JoinFun a -> DataflowLattice a
    DataflowLattice Set CAFfyLabel
    forall a. Set a
    Set.empty JoinFun (Set CAFfyLabel)
    forall {a}.
    Ord a =>
    OldFact (Set a) -> NewFact (Set a) -> JoinedFact (Set a)
    add
      where
        add :: OldFact (Set a) -> NewFact (Set a) -> JoinedFact (Set a)
    add (OldFact Set a
    old) (NewFact Set a
    new) =
            let !new' :: Set a
    new' = Set a
    old Set a -> Set a -> Set a
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.union` Set a
    new
            in Bool -> Set a -> JoinedFact (Set a)
    forall a. Bool -> a -> JoinedFact a
    changedIf (Set a -> WordOff
    forall a. Set a -> WordOff
    Set.size Set a
    new' WordOff -> WordOff -> Bool
    forall a. Ord a => a -> a -> Bool
    > Set a -> WordOff
    forall a. Set a -> WordOff
    Set.size Set a
    old) Set a
    new'

    cafTransfers :: Platform -> LabelSet -> Label -> CLabel -> TransferFun CAFSet
    cafTransfers :: Platform
    -> LabelSet
    -> BlockId
    -> CLabel
    -> TransferFun' CmmNode (Set CAFfyLabel)
    cafTransfers Platform
    platform LabelSet
    contLbls BlockId
    entry CLabel
    topLbl
      block :: CmmBlock
    block@(BlockCC CmmNode C O
    eNode Block CmmNode O O
    middle CmmNode O C
    xNode) CAFEnv
    fBase =
        let joined :: CAFSet
            joined :: Set CAFfyLabel
    joined = CmmNode O C -> Set CAFfyLabel -> Set CAFfyLabel
    forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> Set CAFfyLabel -> Set CAFfyLabel
    cafsInNode CmmNode O C
    xNode (Set CAFfyLabel -> Set CAFfyLabel)
    -> Set CAFfyLabel -> Set CAFfyLabel
    forall a b. (a -> b) -> a -> b
    $! Set CAFfyLabel
    live'

            result :: CAFSet
            !result :: Set CAFfyLabel
    result = (CmmNode O O -> Set CAFfyLabel -> Set CAFfyLabel)
    -> Block CmmNode O O -> Set CAFfyLabel -> Set CAFfyLabel
    forall (node :: Extensibility -> Extensibility -> *) f.
    (node O O -> f -> f) -> Block node O O -> f -> f
    foldNodesBwdOO CmmNode O O -> Set CAFfyLabel -> Set CAFfyLabel
    forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> Set CAFfyLabel -> Set CAFfyLabel
    cafsInNode Block CmmNode O O
    middle Set CAFfyLabel
    joined

            facts :: [Set CAFfyLabel]
            facts :: [Set CAFfyLabel]
    facts = (BlockId -> Maybe (Set CAFfyLabel))
    -> [BlockId] -> [Set CAFfyLabel]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe BlockId -> Maybe (Set CAFfyLabel)
    successorFact (CmmNode O C -> [BlockId]
    forall (e :: Extensibility). CmmNode e C -> [BlockId]
    forall (thing :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    NonLocal thing =>
    thing e C -> [BlockId]
    successors CmmNode O C
    xNode)

            live' :: CAFSet
            live' :: Set CAFfyLabel
    live' = DataflowLattice (Set CAFfyLabel)
    -> [Set CAFfyLabel] -> Set CAFfyLabel
    forall f. DataflowLattice f -> [f] -> f
    joinFacts DataflowLattice (Set CAFfyLabel)
    cafLattice [Set CAFfyLabel]
    facts

            successorFact :: Label -> Maybe (Set CAFfyLabel)
            successorFact :: BlockId -> Maybe (Set CAFfyLabel)
    successorFact BlockId
    s
              -- If this is a loop back to the entry, we can refer to the
              -- entry label.
              | BlockId
    s BlockId -> BlockId -> Bool
    forall a. Eq a => a -> a -> Bool
    == BlockId
    entry = Set CAFfyLabel -> Maybe (Set CAFfyLabel)
    forall a. a -> Maybe a
    Just (Platform -> CLabel -> Set CAFfyLabel -> Set CAFfyLabel
    addCafLabel Platform
    platform CLabel
    topLbl Set CAFfyLabel
    forall a. Set a
    Set.empty)
              -- If this is a continuation, we want to refer to the
              -- SRT for the continuation's info table
              | BlockId
    s BlockId -> LabelSet -> Bool
    `setMember` LabelSet
    contLbls
              = Set CAFfyLabel -> Maybe (Set CAFfyLabel)
    forall a. a -> Maybe a
    Just (CAFfyLabel -> Set CAFfyLabel
    forall a. a -> Set a
    Set.singleton (Platform -> CLabel -> CAFfyLabel
    mkCAFfyLabel Platform
    platform (BlockId -> CLabel
    infoTblLbl BlockId
    s)))
              -- Otherwise, takes the CAF references from the destination
              | Bool
    otherwise
              = BlockId -> CAFEnv -> Maybe (Set CAFfyLabel)
    forall f. BlockId -> FactBase f -> Maybe f
    lookupFact BlockId
    s CAFEnv
    fBase

            cafsInNode :: CmmNode e x -> CAFSet -> CAFSet
            cafsInNode :: forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> Set CAFfyLabel -> Set CAFfyLabel
    cafsInNode CmmNode e x
    node Set CAFfyLabel
    set = (CmmExpr -> Set CAFfyLabel -> Set CAFfyLabel)
    -> CmmNode e x -> Set CAFfyLabel -> Set CAFfyLabel
    forall z (e :: Extensibility) (x :: Extensibility).
    (CmmExpr -> z -> z) -> CmmNode e x -> z -> z
    foldExpDeep CmmExpr -> Set CAFfyLabel -> Set CAFfyLabel
    addCafExpr CmmNode e x
    node Set CAFfyLabel
    set

            addCafExpr :: CmmExpr -> Set CAFfyLabel -> Set CAFfyLabel
            addCafExpr :: CmmExpr -> Set CAFfyLabel -> Set CAFfyLabel
    addCafExpr CmmExpr
    expr !Set CAFfyLabel
    set =
              case CmmExpr
    expr of
                CmmLit (CmmLabel CLabel
    c) ->
                  Platform -> CLabel -> Set CAFfyLabel -> Set CAFfyLabel
    addCafLabel Platform
    platform CLabel
    c Set CAFfyLabel
    set
                CmmLit (CmmLabelOff CLabel
    c WordOff
    _) ->
                  Platform -> CLabel -> Set CAFfyLabel -> Set CAFfyLabel
    addCafLabel Platform
    platform CLabel
    c Set CAFfyLabel
    set
                CmmLit (CmmLabelDiffOff CLabel
    c1 CLabel
    c2 WordOff
    _ Width
    _) ->
                  Platform -> CLabel -> Set CAFfyLabel -> Set CAFfyLabel
    addCafLabel Platform
    platform CLabel
    c1 (Set CAFfyLabel -> Set CAFfyLabel)
    -> Set CAFfyLabel -> Set CAFfyLabel
    forall a b. (a -> b) -> a -> b
    $! Platform -> CLabel -> Set CAFfyLabel -> Set CAFfyLabel
    addCafLabel Platform
    platform CLabel
    c2 Set CAFfyLabel
    set
                CmmExpr
    _ ->
                  Set CAFfyLabel
    set
        in
          String -> SDoc -> CAFEnv -> CAFEnv
    forall b. String -> SDoc -> b -> b
    srtTrace String
    "cafTransfers" (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "block:"         SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> CmmBlock -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmBlock
    block SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                                    String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "contLbls:"     SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> LabelSet -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LabelSet
    contLbls SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                                    String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "entry:"        SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> BlockId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr BlockId
    entry SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                                    String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "topLbl:"       SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CLabel
    topLbl SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                                    String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "cafs in exit:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> Set CAFfyLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform Set CAFfyLabel
    joined SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                                    String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "result:"       SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> Set CAFfyLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform Set CAFfyLabel
    result) (CAFEnv -> CAFEnv) -> CAFEnv -> CAFEnv
    forall a b. (a -> b) -> a -> b
    $
            BlockId -> Set CAFfyLabel -> CAFEnv
    forall v. BlockId -> v -> LabelMap v
    mapSingleton (CmmNode C O -> BlockId
    forall (x :: Extensibility). CmmNode C x -> BlockId
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> BlockId
    entryLabel CmmNode C O
    eNode) Set CAFfyLabel
    result

    -- -----------------------------------------------------------------------------
    -- ModuleSRTInfo

    data ModuleSRTInfo = ModuleSRTInfo
      { ModuleSRTInfo -> Module
    thisModule :: Module
        -- ^ Current module being compiled. Required for calling labelDynamic.
      , ModuleSRTInfo -> Map (Set SRTEntry) SRTEntry
    dedupSRTs :: Map (Set SRTEntry) SRTEntry
        -- ^ previous SRTs we've emitted, so we can de-duplicate.
        -- Used to implement the [Common] optimisation.
      , ModuleSRTInfo -> Map SRTEntry (Set SRTEntry)
    flatSRTs :: Map SRTEntry (Set SRTEntry)
        -- ^ The reverse mapping, so that we can remove redundant
        -- entries. e.g.  if we have an SRT [a,b,c], and we know that b
        -- points to [c,d], we can omit c and emit [a,b].
        -- Used to implement the [Filter] optimisation.
      , ModuleSRTInfo -> SRTMap
    moduleSRTMap :: SRTMap
      }

    instance OutputableP env CLabel => OutputableP env ModuleSRTInfo where
      pdoc :: env -> ModuleSRTInfo -> SDoc
    pdoc env
    env ModuleSRTInfo{Map (Set SRTEntry) SRTEntry
    Map SRTEntry (Set SRTEntry)
    SRTMap
    Module
    thisModule :: ModuleSRTInfo -> Module
    dedupSRTs :: ModuleSRTInfo -> Map (Set SRTEntry) SRTEntry
    flatSRTs :: ModuleSRTInfo -> Map SRTEntry (Set SRTEntry)
    moduleSRTMap :: ModuleSRTInfo -> SRTMap
    thisModule :: Module
    dedupSRTs :: Map (Set SRTEntry) SRTEntry
    flatSRTs :: Map SRTEntry (Set SRTEntry)
    moduleSRTMap :: SRTMap
    ..} =
        String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "ModuleSRTInfo {" SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
          (WordOff -> SDoc -> SDoc
    nest WordOff
    4 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "dedupSRTs ="    SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> env -> Map (Set SRTEntry) SRTEntry -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc env
    env Map (Set SRTEntry) SRTEntry
    dedupSRTs SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                    String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "flatSRTs ="     SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> env -> Map SRTEntry (Set SRTEntry) -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc env
    env Map SRTEntry (Set SRTEntry)
    flatSRTs SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                    String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "moduleSRTMap =" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> env -> SRTMap -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc env
    env SRTMap
    moduleSRTMap) SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '}'

    emptySRT :: Module -> ModuleSRTInfo
    emptySRT :: Module -> ModuleSRTInfo
    emptySRT Module
    mod =
      ModuleSRTInfo
        { thisModule :: Module
    thisModule = Module
    mod
        , dedupSRTs :: Map (Set SRTEntry) SRTEntry
    dedupSRTs = Map (Set SRTEntry) SRTEntry
    forall k a. Map k a
    Map.empty
        , flatSRTs :: Map SRTEntry (Set SRTEntry)
    flatSRTs = Map SRTEntry (Set SRTEntry)
    forall k a. Map k a
    Map.empty
        , moduleSRTMap :: SRTMap
    moduleSRTMap = SRTMap
    forall k a. Map k a
    Map.empty
        }

    -- -----------------------------------------------------------------------------
    -- Constructing SRTs

    {- Implementation notes

    - In each CmmDecl there is a mapping info_tbls from Label -> CmmInfoTable

    - The entry in info_tbls corresponding to g_entry is the closure info
      table, the rest are continuations.

    - Each entry in info_tbls possibly needs an SRT.  We need to make a
      label for each of these.

    - We get the CAFSet for each entry from the CAFEnv

    -}

    data SomeLabel
      = BlockLabel !Label
      | DeclLabel CLabel
      deriving (SomeLabel -> SomeLabel -> Bool
    (SomeLabel -> SomeLabel -> Bool)
    -> (SomeLabel -> SomeLabel -> Bool) -> Eq SomeLabel
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: SomeLabel -> SomeLabel -> Bool
    == :: SomeLabel -> SomeLabel -> Bool
    $c/= :: SomeLabel -> SomeLabel -> Bool
    /= :: SomeLabel -> SomeLabel -> Bool
    Eq, Eq SomeLabel
    Eq SomeLabel =>
    (SomeLabel -> SomeLabel -> Ordering)
    -> (SomeLabel -> SomeLabel -> Bool)
    -> (SomeLabel -> SomeLabel -> Bool)
    -> (SomeLabel -> SomeLabel -> Bool)
    -> (SomeLabel -> SomeLabel -> Bool)
    -> (SomeLabel -> SomeLabel -> SomeLabel)
    -> (SomeLabel -> SomeLabel -> SomeLabel)
    -> Ord SomeLabel
    SomeLabel -> SomeLabel -> Bool
    SomeLabel -> SomeLabel -> Ordering
    SomeLabel -> SomeLabel -> SomeLabel
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: SomeLabel -> SomeLabel -> Ordering
    compare :: SomeLabel -> SomeLabel -> Ordering
    $c< :: SomeLabel -> SomeLabel -> Bool
    < :: SomeLabel -> SomeLabel -> Bool
    $c<= :: SomeLabel -> SomeLabel -> Bool
    <= :: SomeLabel -> SomeLabel -> Bool
    $c> :: SomeLabel -> SomeLabel -> Bool
    > :: SomeLabel -> SomeLabel -> Bool
    $c>= :: SomeLabel -> SomeLabel -> Bool
    >= :: SomeLabel -> SomeLabel -> Bool
    $cmax :: SomeLabel -> SomeLabel -> SomeLabel
    max :: SomeLabel -> SomeLabel -> SomeLabel
    $cmin :: SomeLabel -> SomeLabel -> SomeLabel
    min :: SomeLabel -> SomeLabel -> SomeLabel
    Ord)

    instance OutputableP env CLabel => OutputableP env SomeLabel where
       pdoc :: env -> SomeLabel -> SDoc
    pdoc env
    env = \case
          BlockLabel BlockId
    l -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "b:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> env -> BlockId -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc env
    env BlockId
    l
          DeclLabel CLabel
    l  -> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "s:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> env -> CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc env
    env CLabel
    l

    getBlockLabel :: SomeLabel -> Maybe Label
    getBlockLabel :: SomeLabel -> Maybe BlockId
    getBlockLabel (BlockLabel BlockId
    l) = BlockId -> Maybe BlockId
    forall a. a -> Maybe a
    Just BlockId
    l
    getBlockLabel (DeclLabel CLabel
    _) = Maybe BlockId
    forall a. Maybe a
    Nothing

    getBlockLabels :: [SomeLabel] -> [Label]
    getBlockLabels :: [SomeLabel] -> [BlockId]
    getBlockLabels = (SomeLabel -> Maybe BlockId) -> [SomeLabel] -> [BlockId]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe SomeLabel -> Maybe BlockId
    getBlockLabel

    -- | Return a @(Label,CLabel)@ pair for each labelled block of a 'CmmDecl',
    --   where the label is
    --   - the info label for a continuation or dynamic closure
    --   - the closure label for a top-level function (not a CAF)
    getLabelledBlocks :: Platform -> CmmDecl -> [(SomeLabel, CAFfyLabel)]
    getLabelledBlocks :: Platform -> CmmDecl -> [(SomeLabel, CAFfyLabel)]
    getLabelledBlocks Platform
    platform CmmDecl
    decl = case CmmDecl
    decl of
       CmmData Section
    _ (CmmStaticsRaw CLabel
    _ [CmmStatic]
    _)    -> []
       CmmData Section
    _ (CmmStatics CLabel
    lbl CmmInfoTable
    info CostCentreStack
    _ [CmmLit]
    _ [CmmLit]
    _) -> [ (CLabel -> SomeLabel
    DeclLabel CLabel
    lbl, Platform -> CLabel -> CAFfyLabel
    mkCAFfyLabel Platform
    platform CLabel
    lbl)
                                                | Bool -> Bool
    not (SMRep -> Bool
    isThunkRep (CmmInfoTable -> SMRep
    cit_rep CmmInfoTable
    info))
                                                ]
       CmmProc CmmTopInfo
    top_info CLabel
    _ [GlobalReg]
    _ GenCmmGraph CmmNode
    _           -> [ (BlockId -> SomeLabel
    BlockLabel BlockId
    blockId, CAFfyLabel
    caf_lbl)
                                           | (BlockId
    blockId, CmmInfoTable
    info) <- LabelMap CmmInfoTable -> [(BlockId, CmmInfoTable)]
    forall b. LabelMap b -> [(BlockId, b)]
    mapToList (CmmTopInfo -> LabelMap CmmInfoTable
    info_tbls CmmTopInfo
    top_info)
                                           , let rep :: SMRep
    rep = CmmInfoTable -> SMRep
    cit_rep CmmInfoTable
    info
                                           , Bool -> Bool
    not (SMRep -> Bool
    isStaticRep SMRep
    rep) Bool -> Bool -> Bool
    || Bool -> Bool
    not (SMRep -> Bool
    isThunkRep SMRep
    rep)
                                           , let !caf_lbl :: CAFfyLabel
    caf_lbl = Platform -> CLabel -> CAFfyLabel
    mkCAFfyLabel Platform
    platform (CmmInfoTable -> CLabel
    cit_lbl CmmInfoTable
    info)
                                           ]

    -- | Put the labelled blocks that we will be annotating with SRTs into
    -- dependency order.  This is so that we can process them one at a
    -- time, resolving references to earlier blocks to point to their
    -- SRTs. CAFs themselves are not included here; see 'getCAFs' below.
    depAnalSRTs
      :: Platform
      -> CAFEnv            -- ^ 'CAFEnv' for procedures. From 'cafAnal'.
      -> Map CLabel CAFSet -- ^ CAFEnv for statics. Maps statics to the set of the
                           -- CAFfy things which they refer to. From 'cafAnalData'.
      -> [CmmDecl]         -- ^ the decls to analyse.
      -> [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
    depAnalSRTs :: Platform
    -> CAFEnv
    -> DataCAFEnv
    -> [CmmDecl]
    -> [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
    depAnalSRTs Platform
    platform CAFEnv
    cafEnv DataCAFEnv
    cafEnv_static [CmmDecl]
    decls =
      String
    -> SDoc
    -> [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
    -> [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
    forall b. String -> SDoc -> b -> b
    srtTrace String
    "depAnalSRTs" (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "decls:"  SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> [CmmDecl] -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform [CmmDecl]
    decls SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                               String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "nodes:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> [(SomeLabel, CAFfyLabel, Set CAFfyLabel)] -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform ((Node SomeLabel (SomeLabel, CAFfyLabel, Set CAFfyLabel)
     -> (SomeLabel, CAFfyLabel, Set CAFfyLabel))
    -> [Node SomeLabel (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
    -> [(SomeLabel, CAFfyLabel, Set CAFfyLabel)]
    forall a b. (a -> b) -> [a] -> [b]
    map Node SomeLabel (SomeLabel, CAFfyLabel, Set CAFfyLabel)
    -> (SomeLabel, CAFfyLabel, Set CAFfyLabel)
    forall key payload. Node key payload -> payload
    node_payload [Node SomeLabel (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
    nodes) SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                               String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "graph:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)] -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
    graph) [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
    graph
     where
      labelledBlocks :: [(SomeLabel, CAFfyLabel)]
      labelledBlocks :: [(SomeLabel, CAFfyLabel)]
    labelledBlocks = (CmmDecl -> [(SomeLabel, CAFfyLabel)])
    -> [CmmDecl] -> [(SomeLabel, CAFfyLabel)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Platform -> CmmDecl -> [(SomeLabel, CAFfyLabel)]
    getLabelledBlocks Platform
    platform) [CmmDecl]
    decls
      labelToBlock :: Map CAFfyLabel SomeLabel
      labelToBlock :: Map CAFfyLabel SomeLabel
    labelToBlock = (Map CAFfyLabel SomeLabel
     -> (SomeLabel, CAFfyLabel) -> Map CAFfyLabel SomeLabel)
    -> Map CAFfyLabel SomeLabel
    -> [(SomeLabel, CAFfyLabel)]
    -> Map CAFfyLabel SomeLabel
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (\Map CAFfyLabel SomeLabel
    m (SomeLabel
    v,CAFfyLabel
    k) -> CAFfyLabel
    -> SomeLabel
    -> Map CAFfyLabel SomeLabel
    -> Map CAFfyLabel SomeLabel
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert CAFfyLabel
    k SomeLabel
    v Map CAFfyLabel SomeLabel
    m) Map CAFfyLabel SomeLabel
    forall k a. Map k a
    Map.empty [(SomeLabel, CAFfyLabel)]
    labelledBlocks

      -- the set of graph nodes. A node is identified by either a BlockLabel (in
      -- the case of code) or a DeclLabel (in the case of static data).
      nodes :: [Node SomeLabel (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
      nodes :: [Node SomeLabel (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
    nodes = [ (SomeLabel, CAFfyLabel, Set CAFfyLabel)
    -> SomeLabel
    -> [SomeLabel]
    -> Node SomeLabel (SomeLabel, CAFfyLabel, Set CAFfyLabel)
    forall key payload. payload -> key -> [key] -> Node key payload
    DigraphNode (SomeLabel
    l,CAFfyLabel
    lbl,Set CAFfyLabel
    cafs') SomeLabel
    l
                  ((CAFfyLabel -> Maybe SomeLabel) -> [CAFfyLabel] -> [SomeLabel]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ((CAFfyLabel -> Map CAFfyLabel SomeLabel -> Maybe SomeLabel)
    -> Map CAFfyLabel SomeLabel -> CAFfyLabel -> Maybe SomeLabel
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip CAFfyLabel -> Map CAFfyLabel SomeLabel -> Maybe SomeLabel
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Map CAFfyLabel SomeLabel
    labelToBlock) (Set CAFfyLabel -> [CAFfyLabel]
    forall a. Set a -> [a]
    Set.toList Set CAFfyLabel
    cafs'))
              | (SomeLabel
    l, CAFfyLabel
    lbl) <- [(SomeLabel, CAFfyLabel)]
    labelledBlocks
              , Just (Set CAFfyLabel
    cafs :: Set CAFfyLabel) <-
                  [case SomeLabel
    l of
                     BlockLabel BlockId
    l -> BlockId -> CAFEnv -> Maybe (Set CAFfyLabel)
    forall f. BlockId -> FactBase f -> Maybe f
    mapLookup BlockId
    l CAFEnv
    cafEnv
                     DeclLabel CLabel
    cl -> CLabel -> DataCAFEnv -> Maybe (Set CAFfyLabel)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup CLabel
    cl DataCAFEnv
    cafEnv_static]
              , let cafs' :: Set CAFfyLabel
    cafs' = CAFfyLabel -> Set CAFfyLabel -> Set CAFfyLabel
    forall a. Ord a => a -> Set a -> Set a
    Set.delete CAFfyLabel
    lbl Set CAFfyLabel
    cafs
              ]

      graph :: [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
      graph :: [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
    graph = [Node SomeLabel (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
    -> [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
    forall key payload. Ord key => [Node key payload] -> [SCC payload]
    stronglyConnCompFromEdgedVerticesOrd [Node SomeLabel (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
    nodes

    -- | Get @(Maybe Label, CAFfyLabel, Set CAFfyLabel)@ for each CAF block.
    -- The @Set CAFfyLabel@ represents the set of CAFfy things which this CAF's code
    -- depends upon.
    --
    --  - The 'Label' represents the entry code of the closure. This may be
    --    'Nothing' if it is a standard closure type (e.g. @stg_unpack_cstring@; see
    --    Note [unpack_cstring closures] in StgStdThunks.cmm).
    --  - The 'CAFLabel' is the label of the CAF closure.
    --  - The @Set CAFLabel@ is the set of CAFfy closures which should be included
    --    in the closure's SRT.
    --
    -- Note that CAFs are treated differently from other labelled blocks:
    --
    --  - we never shortcut a reference to a CAF to the contents of its
    --    SRT, since the point of SRTs is to keep CAFs alive.
    --
    --  - CAFs therefore don't take part in the dependency analysis in depAnalSRTs.
    --    instead we generate their SRTs after everything else.
    getCAFs :: Platform -> CAFEnv -> [CmmDecl] -> [(Maybe Label, CAFfyLabel, Set CAFfyLabel)]
    getCAFs :: Platform
    -> CAFEnv
    -> [CmmDecl]
    -> [(Maybe BlockId, CAFfyLabel, Set CAFfyLabel)]
    getCAFs Platform
    platform CAFEnv
    cafEnv = (CmmDecl -> Maybe (Maybe BlockId, CAFfyLabel, Set CAFfyLabel))
    -> [CmmDecl] -> [(Maybe BlockId, CAFfyLabel, Set CAFfyLabel)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe CmmDecl -> Maybe (Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
    getCAFLabel
      where
        getCAFLabel :: CmmDecl -> Maybe (Maybe Label, CAFfyLabel, Set CAFfyLabel)

        getCAFLabel :: CmmDecl -> Maybe (Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
    getCAFLabel (CmmProc CmmTopInfo
    top_info CLabel
    top_lbl [GlobalReg]
    _ GenCmmGraph CmmNode
    g)
          | Just CmmInfoTable
    info <- BlockId -> LabelMap CmmInfoTable -> Maybe CmmInfoTable
    forall f. BlockId -> FactBase f -> Maybe f
    mapLookup (GenCmmGraph CmmNode -> BlockId
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> BlockId
    g_entry GenCmmGraph CmmNode
    g) (CmmTopInfo -> LabelMap CmmInfoTable
    info_tbls CmmTopInfo
    top_info)
          , let rep :: SMRep
    rep = CmmInfoTable -> SMRep
    cit_rep CmmInfoTable
    info
          , SMRep -> Bool
    isStaticRep SMRep
    rep Bool -> Bool -> Bool
    && SMRep -> Bool
    isThunkRep SMRep
    rep
          , Just Set CAFfyLabel
    cafs <- BlockId -> CAFEnv -> Maybe (Set CAFfyLabel)
    forall f. BlockId -> FactBase f -> Maybe f
    mapLookup (GenCmmGraph CmmNode -> BlockId
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> BlockId
    g_entry GenCmmGraph CmmNode
    g) CAFEnv
    cafEnv
          = (Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
    -> Maybe (Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
    forall a. a -> Maybe a
    Just (BlockId -> Maybe BlockId
    forall a. a -> Maybe a
    Just (GenCmmGraph CmmNode -> BlockId
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> BlockId
    g_entry GenCmmGraph CmmNode
    g), Platform -> CLabel -> CAFfyLabel
    mkCAFfyLabel Platform
    platform CLabel
    top_lbl, Set CAFfyLabel
    cafs)

          | Bool
    otherwise
          = Maybe (Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
    forall a. Maybe a
    Nothing

        getCAFLabel (CmmData Section
    _ (CmmStatics CLabel
    top_lbl CmmInfoTable
    info CostCentreStack
    _ccs [CmmLit]
    _payload [CmmLit]
    _extras))
          | SMRep -> Bool
    isThunkRep (CmmInfoTable -> SMRep
    cit_rep CmmInfoTable
    info)
          = (Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
    -> Maybe (Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
    forall a. a -> Maybe a
    Just (Maybe BlockId
    forall a. Maybe a
    Nothing, Platform -> CLabel -> CAFfyLabel
    mkCAFfyLabel Platform
    platform CLabel
    top_lbl, Set CAFfyLabel
    forall a. Set a
    Set.empty)

          | Bool
    otherwise
          = Maybe (Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
    forall a. Maybe a
    Nothing

        getCAFLabel (CmmData Section
    _ (CmmStaticsRaw CLabel
    _lbl [CmmStatic]
    _payload))
          = Maybe (Maybe BlockId, CAFfyLabel, Set CAFfyLabel)
    forall a. Maybe a
    Nothing

    -- | Get the list of blocks that correspond to the entry points for
    -- @FUN_STATIC@ closures.  These are the blocks for which if we have an
    -- SRT we can merge it with the static closure. [FUN]
    getStaticFuns :: [CmmDecl] -> [(BlockId, CLabel)]
    getStaticFuns :: [CmmDecl] -> [(BlockId, CLabel)]
    getStaticFuns [CmmDecl]
    decls =
      [ (GenCmmGraph CmmNode -> BlockId
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> BlockId
    g_entry GenCmmGraph CmmNode
    g, CLabel
    lbl)
      | CmmProc CmmTopInfo
    top_info CLabel
    _ [GlobalReg]
    _ GenCmmGraph CmmNode
    g <- [CmmDecl]
    decls
      , Just CmmInfoTable
    info <- [BlockId -> LabelMap CmmInfoTable -> Maybe CmmInfoTable
    forall f. BlockId -> FactBase f -> Maybe f
    mapLookup (GenCmmGraph CmmNode -> BlockId
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> BlockId
    g_entry GenCmmGraph CmmNode
    g) (CmmTopInfo -> LabelMap CmmInfoTable
    info_tbls CmmTopInfo
    top_info)]
      , Just (Id
    id, CostCentreStack
    _) <- [CmmInfoTable -> Maybe (Id, CostCentreStack)
    cit_clo CmmInfoTable
    info]
      , let rep :: SMRep
    rep = CmmInfoTable -> SMRep
    cit_rep CmmInfoTable
    info
      , SMRep -> Bool
    isStaticRep SMRep
    rep Bool -> Bool -> Bool
    && SMRep -> Bool
    isFunRep SMRep
    rep
      , let !lbl :: CLabel
    lbl = Name -> CafInfo -> CLabel
    mkClosureLabel (Id -> Name
    idName Id
    id) (Id -> CafInfo
    idCafInfo Id
    id)
      ]

    -- | Maps labels from 'cafAnal' to the final CLabel that will appear
    -- in the SRT.
    --   - closures with singleton SRTs resolve to their single entry
    --   - closures with larger SRTs map to the label for that SRT
    --   - CAFs must not map to anything!
    --   - if a labels maps to Nothing, we found that this label's SRT
    --     is empty, so we don't need to refer to it from other SRTs.
    type SRTMap = Map CAFfyLabel (Maybe SRTEntry)

    -- | Given 'SRTMap' of a module, returns the set of non-CAFFY names in the
    -- module.  Any 'Name's not in the set are CAFFY.
    srtMapNonCAFs :: SRTMap -> NonCaffySet
    srtMapNonCAFs :: SRTMap -> NonCaffySet
    srtMapNonCAFs SRTMap
    srtMap =
        NameSet -> NonCaffySet
    NonCaffySet (NameSet -> NonCaffySet) -> NameSet -> NonCaffySet
    forall a b. (a -> b) -> a -> b
    $ [Name] -> NameSet
    mkNameSet (((CAFfyLabel, Maybe SRTEntry) -> Maybe Name)
    -> [(CAFfyLabel, Maybe SRTEntry)] -> [Name]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (CAFfyLabel, Maybe SRTEntry) -> Maybe Name
    forall {a}. (CAFfyLabel, Maybe a) -> Maybe Name
    get_name (SRTMap -> [(CAFfyLabel, Maybe SRTEntry)]
    forall k a. Map k a -> [(k, a)]
    Map.toList SRTMap
    srtMap))
      where
        get_name :: (CAFfyLabel, Maybe a) -> Maybe Name
    get_name (CAFfyLabel CLabel
    l, Maybe a
    Nothing) = CLabel -> Maybe Name
    hasHaskellName CLabel
    l
        get_name (CAFfyLabel
    _l, Just a
    _srt_entry) = Maybe Name
    forall a. Maybe a
    Nothing

    -- | Resolve a CAFfyLabel to its 'SRTEntry' using the 'SRTMap'.
    resolveCAF :: Platform -> SRTMap -> CAFfyLabel -> Maybe SRTEntry
    resolveCAF :: Platform -> SRTMap -> CAFfyLabel -> Maybe SRTEntry
    resolveCAF Platform
    platform SRTMap
    srtMap lbl :: CAFfyLabel
    lbl@(CAFfyLabel CLabel
    l) =
        String -> SDoc -> Maybe SRTEntry -> Maybe SRTEntry
    forall b. String -> SDoc -> b -> b
    srtTrace String
    "resolveCAF" (SDoc
    "l:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CLabel
    l SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    "resolved:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> Maybe SRTEntry -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform Maybe SRTEntry
    ret) Maybe SRTEntry
    ret
      where
        ret :: Maybe SRTEntry
    ret = Maybe SRTEntry -> CAFfyLabel -> SRTMap -> Maybe SRTEntry
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault (SRTEntry -> Maybe SRTEntry
    forall a. a -> Maybe a
    Just (CLabel -> SRTEntry
    SRTEntry (Platform -> CLabel -> CLabel
    toClosureLbl Platform
    platform CLabel
    l))) CAFfyLabel
    lbl SRTMap
    srtMap

    anyCafRefs :: [CafInfo] -> CafInfo
    anyCafRefs :: [CafInfo] -> CafInfo
    anyCafRefs [CafInfo]
    caf_infos = case (CafInfo -> Bool) -> [CafInfo] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any CafInfo -> Bool
    mayHaveCafRefs [CafInfo]
    caf_infos of
                             Bool
    True -> CafInfo
    MayHaveCafRefs
                             Bool
    False -> CafInfo
    NoCafRefs

    -- | Attach SRTs to all info tables in the 'CmmDecl's, and add SRT
    -- declarations to the 'ModuleSRTInfo'.
    --
    doSRTs
      :: CmmConfig
      -> ModuleSRTInfo
      -> [(CAFEnv, [CmmDecl])]   -- ^ 'CAFEnv's and 'CmmDecl's for code blocks
      -> [(CAFSet, CmmDataDecl)]     -- ^ static data decls and their 'CAFSet's
      -> IO (ModuleSRTInfo, [CmmDeclSRTs])

    doSRTs :: CmmConfig
    -> ModuleSRTInfo
    -> [(CAFEnv, [CmmDecl])]
    -> [(Set CAFfyLabel, CmmDataDecl)]
    -> IO (ModuleSRTInfo, [CmmDeclSRTs])
    doSRTs CmmConfig
    cfg ModuleSRTInfo
    moduleSRTInfo [(CAFEnv, [CmmDecl])]
    procs [(Set CAFfyLabel, CmmDataDecl)]
    data_ = do
      us <- Char -> IO UniqSupply
    mkSplitUniqSupply Char
    'u'

      let profile = CmmConfig -> Profile
    cmmProfile CmmConfig
    cfg

      -- Ignore the original grouping of decls, and combine all the
      -- CAFEnvs into a single CAFEnv.
      let static_data_env :: DataCAFEnv
          static_data_env =
            [(CLabel, Set CAFfyLabel)] -> DataCAFEnv
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(CLabel, Set CAFfyLabel)] -> DataCAFEnv)
    -> [(CLabel, Set CAFfyLabel)] -> DataCAFEnv
    forall a b. (a -> b) -> a -> b
    $
            (((Set CAFfyLabel, CmmDataDecl) -> (CLabel, Set CAFfyLabel))
     -> [(Set CAFfyLabel, CmmDataDecl)] -> [(CLabel, Set CAFfyLabel)])
    -> [(Set CAFfyLabel, CmmDataDecl)]
    -> ((Set CAFfyLabel, CmmDataDecl) -> (CLabel, Set CAFfyLabel))
    -> [(CLabel, Set CAFfyLabel)]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((Set CAFfyLabel, CmmDataDecl) -> (CLabel, Set CAFfyLabel))
    -> [(Set CAFfyLabel, CmmDataDecl)] -> [(CLabel, Set CAFfyLabel)]
    forall a b. (a -> b) -> [a] -> [b]
    map [(Set CAFfyLabel, CmmDataDecl)]
    data_ (((Set CAFfyLabel, CmmDataDecl) -> (CLabel, Set CAFfyLabel))
     -> [(CLabel, Set CAFfyLabel)])
    -> ((Set CAFfyLabel, CmmDataDecl) -> (CLabel, Set CAFfyLabel))
    -> [(CLabel, Set CAFfyLabel)]
    forall a b. (a -> b) -> a -> b
    $
            \(Set CAFfyLabel
    set, CmmDataDecl
    decl) ->
              case CmmDataDecl
    decl of
                CmmProc Void
    void CLabel
    _ [GlobalReg]
    _ Void
    _ -> case Void
    void of
                CmmData Section
    _ GenCmmStatics 'False
    static ->
                  case GenCmmStatics 'False
    static of
                    CmmStatics CLabel
    lbl CmmInfoTable
    _ CostCentreStack
    _ [CmmLit]
    _ [CmmLit]
    _ -> (CLabel
    lbl, Set CAFfyLabel
    set)
                    CmmStaticsRaw CLabel
    lbl [CmmStatic]
    _ -> (CLabel
    lbl, Set CAFfyLabel
    set)

          (proc_envs, procss) = unzip procs
          cafEnv = [CAFEnv] -> CAFEnv
    forall a. [LabelMap a] -> LabelMap a
    mapUnions [CAFEnv]
    proc_envs
          decls = ((Set CAFfyLabel, CmmDataDecl) -> CmmDecl)
    -> [(Set CAFfyLabel, CmmDataDecl)] -> [CmmDecl]
    forall a b. (a -> b) -> [a] -> [b]
    map (CmmDataDecl -> CmmDecl
    forall d h g. GenCmmDataDecl d -> GenCmmDecl d h g
    cmmDataDeclCmmDecl (CmmDataDecl -> CmmDecl)
    -> ((Set CAFfyLabel, CmmDataDecl) -> CmmDataDecl)
    -> (Set CAFfyLabel, CmmDataDecl)
    -> CmmDecl
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Set CAFfyLabel, CmmDataDecl) -> CmmDataDecl
    forall a b. (a, b) -> b
    snd) [(Set CAFfyLabel, CmmDataDecl)]
    data_ [CmmDecl] -> [CmmDecl] -> [CmmDecl]
    forall a. [a] -> [a] -> [a]
    ++ [[CmmDecl]] -> [CmmDecl]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[CmmDecl]]
    procss
          staticFuns = [(BlockId, CLabel)] -> LabelMap CLabel
    forall v. [(BlockId, v)] -> LabelMap v
    mapFromList ([CmmDecl] -> [(BlockId, CLabel)]
    getStaticFuns [CmmDecl]
    decls)

          platform = CmmConfig -> Platform
    cmmPlatform CmmConfig
    cfg

      -- Put the decls in dependency order. Why? So that we can implement
      -- [Inline] and [Filter].  If we need to refer to an SRT that has
      -- a single entry, we use the entry itself, which means that we
      -- don't need to generate the singleton SRT in the first place.  But
      -- to do this we need to process blocks before things that depend on
      -- them.
      let
        sccs :: [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
        sccs = {-# SCC depAnalSRTs #-} Platform
    -> CAFEnv
    -> DataCAFEnv
    -> [CmmDecl]
    -> [SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)]
    depAnalSRTs Platform
    platform CAFEnv
    cafEnv DataCAFEnv
    static_data_env [CmmDecl]
    decls

        cafsWithSRTs :: [(Maybe Label, CAFfyLabel, Set CAFfyLabel)]
        cafsWithSRTs = Platform
    -> CAFEnv
    -> [CmmDecl]
    -> [(Maybe BlockId, CAFfyLabel, Set CAFfyLabel)]
    getCAFs Platform
    platform CAFEnv
    cafEnv [CmmDecl]
    decls

      srtTraceM "doSRTs" (text "data:"            <+> pdoc platform data_ $$
                          text "procs:"           <+> pdoc platform procs $$
                          text "static_data_env:" <+> pdoc platform static_data_env $$
                          text "sccs:"            <+> pdoc platform sccs $$
                          text "cafsWithSRTs:"    <+> pdoc platform cafsWithSRTs)

      -- On each strongly-connected group of decls, construct the SRT
      -- closures and the SRT fields for info tables.
      let result ::
            [ ( [CmmDeclSRTs]          -- generated SRTs
              , [(Label, CLabel)]      -- SRT fields for info tables
              , [(Label, [SRTEntry])]  -- SRTs to attach to static functions
              , CafInfo                -- Whether the group has CAF references
              ) ]

          (result, moduleSRTInfo') =
            initUs_ us $
            flip runStateT moduleSRTInfo $ do
              nonCAFs <- mapM (doSCC cfg staticFuns static_data_env) sccs
              cAFs <- forM cafsWithSRTs $ \(Maybe BlockId
    l, CAFfyLabel
    cafLbl, Set CAFfyLabel
    cafs) ->
                CmmConfig
    -> LabelMap CLabel
    -> [SomeLabel]
    -> [CAFfyLabel]
    -> Bool
    -> Set CAFfyLabel
    -> DataCAFEnv
    -> StateT
         ModuleSRTInfo
         UniqSM
         ([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
          CafInfo)
    oneSRT CmmConfig
    cfg LabelMap CLabel
    staticFuns ((BlockId -> SomeLabel) -> [BlockId] -> [SomeLabel]
    forall a b. (a -> b) -> [a] -> [b]
    map BlockId -> SomeLabel
    BlockLabel (Maybe BlockId -> [BlockId]
    forall a. Maybe a -> [a]
    maybeToList Maybe BlockId
    l)) [CAFfyLabel
    cafLbl]
                       Bool
    True{-is a CAF-} Set CAFfyLabel
    cafs DataCAFEnv
    static_data_env
              return (nonCAFs ++ cAFs)

          (srt_declss, pairs, funSRTs, has_caf_refs) = unzip4 result
          srt_decls = [[CmmDeclSRTs]] -> [CmmDeclSRTs]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[CmmDeclSRTs]]
    srt_declss

      -- Next, update the info tables with the SRTs
      let
        srtFieldMap = [(BlockId, CLabel)] -> LabelMap CLabel
    forall v. [(BlockId, v)] -> LabelMap v
    mapFromList ([[(BlockId, CLabel)]] -> [(BlockId, CLabel)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[(BlockId, CLabel)]]
    pairs)
        funSRTMap = [(BlockId, [SRTEntry])] -> LabelMap [SRTEntry]
    forall v. [(BlockId, v)] -> LabelMap v
    mapFromList ([[(BlockId, [SRTEntry])]] -> [(BlockId, [SRTEntry])]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[(BlockId, [SRTEntry])]]
    funSRTs)
        has_caf_refs' = [CafInfo] -> CafInfo
    anyCafRefs [CafInfo]
    has_caf_refs
        decls' =
          (CmmDecl -> [CmmDeclSRTs]) -> [CmmDecl] -> [CmmDeclSRTs]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Profile
    -> LabelMap CLabel
    -> LabelMap [SRTEntry]
    -> CafInfo
    -> CmmDecl
    -> [CmmDeclSRTs]
    updInfoSRTs Profile
    profile LabelMap CLabel
    srtFieldMap LabelMap [SRTEntry]
    funSRTMap CafInfo
    has_caf_refs') [CmmDecl]
    decls

      -- Finally update CafInfos for raw static literals (CmmStaticsRaw). Those are
      -- not analysed in oneSRT so we never add entries for them to the SRTMap.
      let srtMap_w_raws =
            (SRTMap -> (Set CAFfyLabel, CmmDataDecl) -> SRTMap)
    -> SRTMap -> [(Set CAFfyLabel, CmmDataDecl)] -> SRTMap
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (\(SRTMap
    srtMap :: SRTMap) (Set CAFfyLabel
    _, CmmDataDecl
    decl) ->
                      case CmmDataDecl
    decl of
                        CmmData Section
    _ CmmStatics{} ->
                          -- already updated by oneSRT
                          SRTMap
    srtMap
                        CmmData Section
    _ (CmmStaticsRaw CLabel
    lbl [CmmStatic]
    _)
                          | CLabel -> Bool
    isIdLabel CLabel
    lbl Bool -> Bool -> Bool
    && Bool -> Bool
    not (CLabel -> Bool
    isTickyLabel CLabel
    lbl) ->
                              -- Raw data are not analysed by oneSRT and they can't
                              -- be CAFFY.
                              -- See Note [Ticky labels in SRT analysis] above for
                              -- why we exclude ticky labels here.
                              CAFfyLabel -> Maybe SRTEntry -> SRTMap -> SRTMap
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert (Platform -> CLabel -> CAFfyLabel
    mkCAFfyLabel Platform
    platform CLabel
    lbl) Maybe SRTEntry
    forall a. Maybe a
    Nothing SRTMap
    srtMap
                          | Bool
    otherwise ->
                              -- Not an IdLabel, ignore
                              SRTMap
    srtMap
                        CmmProc Void
    void CLabel
    _ [GlobalReg]
    _ Void
    _ -> case Void
    void of)
                   (ModuleSRTInfo -> SRTMap
    moduleSRTMap ModuleSRTInfo
    moduleSRTInfo') [(Set CAFfyLabel, CmmDataDecl)]
    data_

      return (moduleSRTInfo'{ moduleSRTMap = srtMap_w_raws }, srt_decls ++ decls')

    -- | Build the SRT for a strongly-connected component of blocks.
    doSCC
      :: CmmConfig
      -> LabelMap CLabel -- ^ which blocks are static function entry points
      -> DataCAFEnv      -- ^ static data
      -> SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)
      -> StateT ModuleSRTInfo UniqSM
            ( [CmmDeclSRTs]          -- generated SRTs
            , [(Label, CLabel)]      -- SRT fields for info tables
            , [(Label, [SRTEntry])]  -- SRTs to attach to static functions
            , CafInfo                -- Whether the group has CAF references
            )

    doSCC :: CmmConfig
    -> LabelMap CLabel
    -> DataCAFEnv
    -> SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)
    -> StateT
         ModuleSRTInfo
         UniqSM
         ([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
          CafInfo)
    doSCC CmmConfig
    cfg LabelMap CLabel
    staticFuns DataCAFEnv
    static_data_env (AcyclicSCC (SomeLabel
    l, CAFfyLabel
    cafLbl, Set CAFfyLabel
    cafs)) =
      CmmConfig
    -> LabelMap CLabel
    -> [SomeLabel]
    -> [CAFfyLabel]
    -> Bool
    -> Set CAFfyLabel
    -> DataCAFEnv
    -> StateT
         ModuleSRTInfo
         UniqSM
         ([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
          CafInfo)
    oneSRT CmmConfig
    cfg LabelMap CLabel
    staticFuns [SomeLabel
    l] [CAFfyLabel
    cafLbl] Bool
    False Set CAFfyLabel
    cafs DataCAFEnv
    static_data_env

    doSCC CmmConfig
    cfg LabelMap CLabel
    staticFuns DataCAFEnv
    static_data_env (CyclicSCC [(SomeLabel, CAFfyLabel, Set CAFfyLabel)]
    nodes) = do
      -- build a single SRT for the whole cycle, see Note [recursive SRTs]
      let ([SomeLabel]
    lbls, [CAFfyLabel]
    caf_lbls, [Set CAFfyLabel]
    cafsets) = [(SomeLabel, CAFfyLabel, Set CAFfyLabel)]
    -> ([SomeLabel], [CAFfyLabel], [Set CAFfyLabel])
    forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 [(SomeLabel, CAFfyLabel, Set CAFfyLabel)]
    nodes
          cafs :: Set CAFfyLabel
    cafs = [Set CAFfyLabel] -> Set CAFfyLabel
    forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
    Set.unions [Set CAFfyLabel]
    cafsets
      CmmConfig
    -> LabelMap CLabel
    -> [SomeLabel]
    -> [CAFfyLabel]
    -> Bool
    -> Set CAFfyLabel
    -> DataCAFEnv
    -> StateT
         ModuleSRTInfo
         UniqSM
         ([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
          CafInfo)
    oneSRT CmmConfig
    cfg LabelMap CLabel
    staticFuns [SomeLabel]
    lbls [CAFfyLabel]
    caf_lbls Bool
    False Set CAFfyLabel
    cafs DataCAFEnv
    static_data_env

    {- Note [recursive SRTs]
       ~~~~~~~~~~~~~~~~~~~~~
    If the dependency analyser has found us a recursive group of
    declarations, then we build a single SRT for the whole group, on the
    grounds that everything in the group is reachable from everything
    else, so we lose nothing by having a single SRT.

    However, there are a couple of wrinkles to be aware of.

    * The Set CAFfyLabel for this SRT will contain labels in the group
      itself. The SRTMap will therefore not contain entries for these labels
      yet, so we can't turn them into SRTEntries using resolveCAF. BUT we
      can just remove recursive references from the Set CAFLabel before
      generating the SRT - the group SRT will consist of the union of the SRTs of
      each of group's constituents minus recursive references.

    * That is, EXCEPT for static function closures and static data constructor
      applications. For the same reason described in Note [No static object
      resurrection], we cannot omit references to static function closures and
      constructor applications.

      But, since we will merge the SRT with one of the static function
      closures (see [FUN]), we can omit references to *that* static
      function closure from the SRT.

    * Similarly, we must reintroduce recursive references to static data
      constructor applications into the group's SRT.
    -}

    -- | Build an SRT for a set of blocks
    oneSRT
      :: CmmConfig
      -> LabelMap CLabel            -- ^ which blocks are static function entry points
      -> [SomeLabel]                -- ^ blocks in this set
      -> [CAFfyLabel]               -- ^ labels for those blocks
      -> Bool                       -- ^ True <=> this SRT is for a CAF
      -> Set CAFfyLabel             -- ^ SRT for this set
      -> DataCAFEnv                 -- Static data labels in this group
      -> StateT ModuleSRTInfo UniqSM
           ( [CmmDeclSRTs]                -- SRT objects we built
           , [(Label, CLabel)]            -- SRT fields for these blocks' itbls
           , [(Label, [SRTEntry])]        -- SRTs to attach to static functions
           , CafInfo                      -- Whether the group has CAF references
           )

    oneSRT :: CmmConfig
    -> LabelMap CLabel
    -> [SomeLabel]
    -> [CAFfyLabel]
    -> Bool
    -> Set CAFfyLabel
    -> DataCAFEnv
    -> StateT
         ModuleSRTInfo
         UniqSM
         ([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
          CafInfo)
    oneSRT CmmConfig
    cfg LabelMap CLabel
    staticFuns [SomeLabel]
    lbls [CAFfyLabel]
    caf_lbls Bool
    isCAF Set CAFfyLabel
    cafs DataCAFEnv
    static_data_env = do
      topSRT <- StateT ModuleSRTInfo UniqSM ModuleSRTInfo
    forall (m :: * -> *) s. Monad m => StateT s m s
    get

      let
        this_mod = ModuleSRTInfo -> Module
    thisModule ModuleSRTInfo
    topSRT
        profile  = CmmConfig -> Profile
    cmmProfile CmmConfig
    cfg
        platform = Profile -> Platform
    profilePlatform Profile
    profile
        srtMap   = ModuleSRTInfo -> SRTMap
    moduleSRTMap ModuleSRTInfo
    topSRT

        blockids = [SomeLabel] -> [BlockId]
    getBlockLabels [SomeLabel]
    lbls

        -- Can we merge this SRT with a FUN_STATIC closure?
        maybeFunClosure :: Maybe (CLabel, Label)
        otherFunLabels :: [CLabel]
        (maybeFunClosure, otherFunLabels) =
          case [ (l,b) | b <- blockids, Just l <- [mapLookup b staticFuns] ] of
            [] -> (Maybe (CLabel, BlockId)
    forall a. Maybe a
    Nothing, [])
            ((CLabel
    l,BlockId
    b):[(CLabel, BlockId)]
    xs) -> ((CLabel, BlockId) -> Maybe (CLabel, BlockId)
    forall a. a -> Maybe a
    Just (CLabel
    l,BlockId
    b), ((CLabel, BlockId) -> CLabel) -> [(CLabel, BlockId)] -> [CLabel]
    forall a b. (a -> b) -> [a] -> [b]
    map (CLabel, BlockId) -> CLabel
    forall a b. (a, b) -> a
    fst [(CLabel, BlockId)]
    xs)

        -- Remove recursive references from the SRT as described in
        -- Note [recursive SRTs]. We carefully reintroduce references to static
        -- functions and data constructor applications below, as is necessary due
        -- to Note [No static object resurrection].
        nonRec :: Set CAFfyLabel
        nonRec = Set CAFfyLabel
    cafs Set CAFfyLabel -> Set CAFfyLabel -> Set CAFfyLabel
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.difference` [CAFfyLabel] -> Set CAFfyLabel
    forall a. Ord a => [a] -> Set a
    Set.fromList [CAFfyLabel]
    caf_lbls

        -- Resolve references to their SRT entries
        resolved :: [SRTEntry]
        resolved = (CAFfyLabel -> Maybe SRTEntry) -> [CAFfyLabel] -> [SRTEntry]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Platform -> SRTMap -> CAFfyLabel -> Maybe SRTEntry
    resolveCAF Platform
    platform SRTMap
    srtMap) (Set CAFfyLabel -> [CAFfyLabel]
    forall a. Set a -> [a]
    Set.toList Set CAFfyLabel
    nonRec)

        -- The set of all SRTEntries in SRTs that we refer to from here.
        allBelow =
          [Set SRTEntry] -> Set SRTEntry
    forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
    Set.unions [ Set SRTEntry
    lbls | SRTEntry
    caf <- [SRTEntry]
    resolved
                            , Just Set SRTEntry
    lbls <- [SRTEntry -> Map SRTEntry (Set SRTEntry) -> Maybe (Set SRTEntry)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup SRTEntry
    caf (ModuleSRTInfo -> Map SRTEntry (Set SRTEntry)
    flatSRTs ModuleSRTInfo
    topSRT)] ]

        -- Remove SRTEntries that are also in an SRT that we refer to.
        -- Implements the [Filter] optimisation.
        filtered0 = [SRTEntry] -> Set SRTEntry
    forall a. Ord a => [a] -> Set a
    Set.fromList [SRTEntry]
    resolved Set SRTEntry -> Set SRTEntry -> Set SRTEntry
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.difference` Set SRTEntry
    allBelow

      srtTraceM "oneSRT:"
         (text "srtMap:"          <+> pdoc platform srtMap $$
          text "nonRec:"          <+> pdoc platform nonRec $$
          text "lbls:"            <+> pdoc platform lbls $$
          text "caf_lbls:"        <+> pdoc platform caf_lbls $$
          text "static_data_env:" <+> pdoc platform static_data_env $$
          text "cafs:"            <+> pdoc platform cafs $$
          text "blockids:"        <+> ppr blockids $$
          text "maybeFunClosure:" <+> pdoc platform maybeFunClosure $$
          text "otherFunLabels:"  <+> pdoc platform otherFunLabels $$
          text "resolved:"        <+> pdoc platform resolved $$
          text "allBelow:"        <+> pdoc platform allBelow $$
          text "filtered0:"       <+> pdoc platform filtered0)

      let
        isStaticFun = Maybe (CLabel, BlockId) -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe (CLabel, BlockId)
    maybeFunClosure

        -- For a label without a closure (e.g. a continuation), we must
        -- update the SRTMap for the label to point to a closure. It's
        -- important that we don't do this for static functions or CAFs,
        -- see Note [Invalid optimisation: shortcutting].
        updateSRTMap :: Maybe SRTEntry -> StateT ModuleSRTInfo UniqSM ()
        updateSRTMap Maybe SRTEntry
    srtEntry =
          String
    -> SDoc
    -> StateT ModuleSRTInfo UniqSM ()
    -> StateT ModuleSRTInfo UniqSM ()
    forall b. String -> SDoc -> b -> b
    srtTrace String
    "updateSRTMap"
            (Platform -> Maybe SRTEntry -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform Maybe SRTEntry
    srtEntry SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    "isCAF:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Bool -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Bool
    isCAF SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+>
             SDoc
    "isStaticFun:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Bool -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Bool
    isStaticFun) (StateT ModuleSRTInfo UniqSM () -> StateT ModuleSRTInfo UniqSM ())
    -> StateT ModuleSRTInfo UniqSM () -> StateT ModuleSRTInfo UniqSM ()
    forall a b. (a -> b) -> a -> b
    $
          Bool
    -> StateT ModuleSRTInfo UniqSM () -> StateT ModuleSRTInfo UniqSM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not Bool
    isCAF Bool -> Bool -> Bool
    && (Bool -> Bool
    not Bool
    isStaticFun Bool -> Bool -> Bool
    || Maybe SRTEntry -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe SRTEntry
    srtEntry)) (StateT ModuleSRTInfo UniqSM () -> StateT ModuleSRTInfo UniqSM ())
    -> StateT ModuleSRTInfo UniqSM () -> StateT ModuleSRTInfo UniqSM ()
    forall a b. (a -> b) -> a -> b
    $
            (ModuleSRTInfo -> ModuleSRTInfo) -> StateT ModuleSRTInfo UniqSM ()
    forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
    modify' ((ModuleSRTInfo -> ModuleSRTInfo)
     -> StateT ModuleSRTInfo UniqSM ())
    -> (ModuleSRTInfo -> ModuleSRTInfo)
    -> StateT ModuleSRTInfo UniqSM ()
    forall a b. (a -> b) -> a -> b
    $ \ModuleSRTInfo
    state ->
               let !srt_map :: SRTMap
    srt_map =
                     (SRTMap -> CAFfyLabel -> SRTMap)
    -> SRTMap -> [CAFfyLabel] -> SRTMap
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (\SRTMap
    srt_map cafLbl :: CAFfyLabel
    cafLbl@(CAFfyLabel CLabel
    clbl) ->
                              -- Only map static data to Nothing (== not CAFFY). For CAFFY
                              -- statics we refer to the static itself instead of a SRT.
                              if Bool -> Bool
    not (CLabel -> DataCAFEnv -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    Map.member CLabel
    clbl DataCAFEnv
    static_data_env) Bool -> Bool -> Bool
    || Maybe SRTEntry -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe SRTEntry
    srtEntry then
                                CAFfyLabel -> Maybe SRTEntry -> SRTMap -> SRTMap
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert CAFfyLabel
    cafLbl Maybe SRTEntry
    srtEntry SRTMap
    srt_map
                              else
                                SRTMap
    srt_map)
                            (ModuleSRTInfo -> SRTMap
    moduleSRTMap ModuleSRTInfo
    state)
                            [CAFfyLabel]
    caf_lbls
               in
                   ModuleSRTInfo
    state{ moduleSRTMap = srt_map }

        allStaticData =
          (CAFfyLabel -> Bool) -> [CAFfyLabel] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (\(CAFfyLabel CLabel
    clbl) -> CLabel -> DataCAFEnv -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    Map.member CLabel
    clbl DataCAFEnv
    static_data_env) [CAFfyLabel]
    caf_lbls

      if Set.null filtered0 then do
        srtTraceM "oneSRT: empty" (pdoc platform caf_lbls)
        updateSRTMap Nothing
        return ([], [], [], NoCafRefs)
      else do
        -- We're going to build an SRT for this group, which should include function
        -- references in the group. See Note [recursive SRTs].
        let allBelow_funs =
              [SRTEntry] -> Set SRTEntry
    forall a. Ord a => [a] -> Set a
    Set.fromList ((CLabel -> SRTEntry) -> [CLabel] -> [SRTEntry]
    forall a b. (a -> b) -> [a] -> [b]
    map (CLabel -> SRTEntry
    SRTEntry (CLabel -> SRTEntry) -> (CLabel -> CLabel) -> CLabel -> SRTEntry
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Platform -> CLabel -> CLabel
    toClosureLbl Platform
    platform) [CLabel]
    otherFunLabels)
        -- We must also ensure that all CAFfy static data constructor applications
        -- are included. See Note [recursive SRTs] and #20959.
        let allBelow_data =
              [SRTEntry] -> Set SRTEntry
    forall a. Ord a => [a] -> Set a
    Set.fromList
              [ CLabel -> SRTEntry
    SRTEntry (CLabel -> SRTEntry) -> CLabel -> SRTEntry
    forall a b. (a -> b) -> a -> b
    $ Platform -> CLabel -> CLabel
    toClosureLbl Platform
    platform CLabel
    lbl
              | DeclLabel CLabel
    lbl <- [SomeLabel]
    lbls
              , Just Set CAFfyLabel
    refs <- Maybe (Set CAFfyLabel) -> [Maybe (Set CAFfyLabel)]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe (Set CAFfyLabel) -> [Maybe (Set CAFfyLabel)])
    -> Maybe (Set CAFfyLabel) -> [Maybe (Set CAFfyLabel)]
    forall a b. (a -> b) -> a -> b
    $ CLabel -> DataCAFEnv -> Maybe (Set CAFfyLabel)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup CLabel
    lbl DataCAFEnv
    static_data_env
              , Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Set CAFfyLabel -> Bool
    forall a. Set a -> Bool
    Set.null Set CAFfyLabel
    refs
              ]
        let filtered = Set SRTEntry
    filtered0 Set SRTEntry -> Set SRTEntry -> Set SRTEntry
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.union` Set SRTEntry
    allBelow_funs Set SRTEntry -> Set SRTEntry -> Set SRTEntry
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.union` Set SRTEntry
    allBelow_data
        srtTraceM "oneSRT" (text "filtered:"      <+> pdoc platform filtered $$
                            text "allBelow_funs:" <+> pdoc platform allBelow_funs)
        case Set.toList filtered of
          [] -> String
    -> SDoc
    -> StateT
         ModuleSRTInfo
         UniqSM
         ([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
          CafInfo)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "oneSRT" SDoc
    forall doc. IsOutput doc => doc
    empty -- unreachable

          -- [Inline] - when we have only one entry there is no need to
          -- build an SRT object at all, instead we put the singleton SRT
          -- entry in the info table.
          [one :: SRTEntry
    one@(SRTEntry CLabel
    lbl)]
            | -- Info tables refer to SRTs by offset (as noted in the section
              -- "Referring to an SRT from the info table" of Note [SRTs]). However,
              -- when dynamic linking is used we cannot guarantee that the offset
              -- between the SRT and the info table will fit in the offset field.
              -- Consequently we build a singleton SRT in this case.
              Bool -> Bool
    not (Module -> Platform -> Bool -> CLabel -> Bool
    labelDynamic Module
    this_mod Platform
    platform (CmmConfig -> Bool
    cmmExternalDynamicRefs CmmConfig
    cfg) CLabel
    lbl)

              -- MachO relocations can't express offsets between compilation units at
              -- all, so we are always forced to build a singleton SRT in this case
              -- (cf #15169)
                Bool -> Bool -> Bool
    && (Bool -> Bool
    not (OS -> Bool
    osMachOTarget (OS -> Bool) -> OS -> Bool
    forall a b. (a -> b) -> a -> b
    $ Platform -> OS
    platformOS (Platform -> OS) -> Platform -> OS
    forall a b. (a -> b) -> a -> b
    $ Profile -> Platform
    profilePlatform Profile
    profile)
                   Bool -> Bool -> Bool
    || Module -> CLabel -> Bool
    isLocalCLabel Module
    this_mod CLabel
    lbl) -> do

              -- If we have a static function closure, then it becomes the
              -- SRT object, and everything else points to it. (the only way
              -- we could have multiple labels here is if this is a
              -- recursive group, see Note [recursive SRTs])
              case Maybe (CLabel, BlockId)
    maybeFunClosure of
                Just (CLabel
    staticFunLbl,BlockId
    staticFunBlock) ->
                    ([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
     CafInfo)
    -> StateT
         ModuleSRTInfo
         UniqSM
         ([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
          CafInfo)
    forall a. a -> StateT ModuleSRTInfo UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [(BlockId, CLabel)]
    withLabels, [], CafInfo
    MayHaveCafRefs)
                  where
                    withLabels :: [(BlockId, CLabel)]
    withLabels =
                      [ (BlockId
    b, if BlockId
    b BlockId -> BlockId -> Bool
    forall a. Eq a => a -> a -> Bool
    == BlockId
    staticFunBlock then CLabel
    lbl else CLabel
    staticFunLbl)
                      | BlockId
    b <- [BlockId]
    blockids ]
                Maybe (CLabel, BlockId)
    Nothing -> do
                  String -> SDoc -> StateT ModuleSRTInfo UniqSM ()
    forall (f :: * -> *). Applicative f => String -> SDoc -> f ()
    srtTraceM String
    "oneSRT: one" (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "caf_lbls:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> [CAFfyLabel] -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform [CAFfyLabel]
    caf_lbls SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                                           String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "one:"      SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> SRTEntry -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform SRTEntry
    one)
                  Maybe SRTEntry -> StateT ModuleSRTInfo UniqSM ()
    updateSRTMap (SRTEntry -> Maybe SRTEntry
    forall a. a -> Maybe a
    Just SRTEntry
    one)
                  ([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
     CafInfo)
    -> StateT
         ModuleSRTInfo
         UniqSM
         ([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
          CafInfo)
    forall a. a -> StateT ModuleSRTInfo UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], (BlockId -> (BlockId, CLabel)) -> [BlockId] -> [(BlockId, CLabel)]
    forall a b. (a -> b) -> [a] -> [b]
    map (,CLabel
    lbl) [BlockId]
    blockids, [], CafInfo
    MayHaveCafRefs)

          [SRTEntry]
    cafList | Bool
    allStaticData ->
            let caffiness :: CafInfo
    caffiness = if [SRTEntry] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [SRTEntry]
    cafList then CafInfo
    NoCafRefs else CafInfo
    MayHaveCafRefs
            in ([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
     CafInfo)
    -> StateT
         ModuleSRTInfo
         UniqSM
         ([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
          CafInfo)
    forall a. a -> StateT ModuleSRTInfo UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [], [], CafInfo
    caffiness)

          [SRTEntry]
    cafList ->
            -- Check whether an SRT with the same entries has been emitted already.
            -- Implements the [Common] optimisation.
            case Set SRTEntry -> Map (Set SRTEntry) SRTEntry -> Maybe SRTEntry
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Set SRTEntry
    filtered (ModuleSRTInfo -> Map (Set SRTEntry) SRTEntry
    dedupSRTs ModuleSRTInfo
    topSRT) of
              Just srtEntry :: SRTEntry
    srtEntry@(SRTEntry CLabel
    srtLbl)  -> do
                String -> SDoc -> StateT ModuleSRTInfo UniqSM ()
    forall (f :: * -> *). Applicative f => String -> SDoc -> f ()
    srtTraceM String
    "oneSRT [Common]" (Platform -> [CAFfyLabel] -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform [CAFfyLabel]
    caf_lbls SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Platform -> CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CLabel
    srtLbl)
                Maybe SRTEntry -> StateT ModuleSRTInfo UniqSM ()
    updateSRTMap (SRTEntry -> Maybe SRTEntry
    forall a. a -> Maybe a
    Just SRTEntry
    srtEntry)
                ([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
     CafInfo)
    -> StateT
         ModuleSRTInfo
         UniqSM
         ([CmmDeclSRTs], [(BlockId, CLabel)], [(BlockId, [SRTEntry])],
          CafInfo)
    forall a. a -> StateT ModuleSRTInfo UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], (BlockId -> (BlockId, CLabel)) -> [BlockId] -> [(BlockId, CLabel)]
    forall a b. (a -> b) -> [a] -> [b]
    map (,CLabel
    srtLbl) [BlockId]
    blockids, [], CafInfo
    MayHaveCafRefs)
              Maybe SRTEntry
    Nothing -> do
                -- No duplicates: we have to build a new SRT object
                (decls, funSRTs, srtEntry) <-
                  case Maybe (CLabel, BlockId)
    maybeFunClosure of
                    Just (CLabel
    fun,BlockId
    block) ->
                      ([CmmDeclSRTs], [(BlockId, [SRTEntry])], SRTEntry)
    -> StateT
         ModuleSRTInfo
         UniqSM
         ([CmmDeclSRTs], [(BlockId, [SRTEntry])], SRTEntry)
    forall a. a -> StateT ModuleSRTInfo UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( [], [(BlockId
    block, [SRTEntry]
    cafList)], CLabel -> SRTEntry
    SRTEntry CLabel
    fun )
                    Maybe (CLabel, BlockId)
    Nothing -> do
                      (decls, entry) <- UniqSM ([CmmDeclSRTs], SRTEntry)
    -> StateT ModuleSRTInfo UniqSM ([CmmDeclSRTs], SRTEntry)
    forall (m :: * -> *) a. Monad m => m a -> StateT ModuleSRTInfo m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (UniqSM ([CmmDeclSRTs], SRTEntry)
     -> StateT ModuleSRTInfo UniqSM ([CmmDeclSRTs], SRTEntry))
    -> UniqSM ([CmmDeclSRTs], SRTEntry)
    -> StateT ModuleSRTInfo UniqSM ([CmmDeclSRTs], SRTEntry)
    forall a b. (a -> b) -> a -> b
    $ Profile -> [SRTEntry] -> UniqSM ([CmmDeclSRTs], SRTEntry)
    buildSRTChain Profile
    profile [SRTEntry]
    cafList
                      return (decls, [], entry)
                updateSRTMap (Just srtEntry)
                let allBelowThis = Set SRTEntry -> Set SRTEntry -> Set SRTEntry
    forall a. Ord a => Set a -> Set a -> Set a
    Set.union Set SRTEntry
    allBelow Set SRTEntry
    filtered
                    newFlatSRTs = SRTEntry
    -> Set SRTEntry
    -> Map SRTEntry (Set SRTEntry)
    -> Map SRTEntry (Set SRTEntry)
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert SRTEntry
    srtEntry Set SRTEntry
    allBelowThis (ModuleSRTInfo -> Map SRTEntry (Set SRTEntry)
    flatSRTs ModuleSRTInfo
    topSRT)
                    -- When all definition in this group are static data we don't
                    -- generate any SRTs.
                    newDedupSRTs = Set SRTEntry
    -> SRTEntry
    -> Map (Set SRTEntry) SRTEntry
    -> Map (Set SRTEntry) SRTEntry
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert Set SRTEntry
    filtered SRTEntry
    srtEntry (ModuleSRTInfo -> Map (Set SRTEntry) SRTEntry
    dedupSRTs ModuleSRTInfo
    topSRT)
                modify' (\ModuleSRTInfo
    state -> ModuleSRTInfo
    state{ dedupSRTs = newDedupSRTs,
                                          flatSRTs = newFlatSRTs })
                srtTraceM "oneSRT: new" (text "caf_lbls:"      <+> pdoc platform caf_lbls $$
                                          text "filtered:"     <+> pdoc platform filtered $$
                                          text "srtEntry:"     <+> pdoc platform srtEntry $$
                                          text "newDedupSRTs:" <+> pdoc platform newDedupSRTs $$
                                          text "newFlatSRTs:"  <+> pdoc platform newFlatSRTs)
                let SRTEntry lbl = srtEntry
                return (decls, map (,lbl) blockids, funSRTs, MayHaveCafRefs)

    -- | Build a static SRT object (or a chain of objects) from a list of
    -- 'SRTEntry's.
    buildSRTChain
       :: Profile
       -> [SRTEntry]
       -> UniqSM
            ( [CmmDeclSRTs] -- The SRT object(s)
            , SRTEntry      -- label to use in the info table
            )
    buildSRTChain :: Profile -> [SRTEntry] -> UniqSM ([CmmDeclSRTs], SRTEntry)
    buildSRTChain Profile
    profile [SRTEntry]
    cafSet =
      case WordOff -> [SRTEntry] -> ([SRTEntry], [SRTEntry])
    forall a. WordOff -> [a] -> ([a], [a])
    splitAt WordOff
    mAX_SRT_SIZE [SRTEntry]
    cafSet of
        ([], [SRTEntry]
    _) -> String -> UniqSM ([CmmDeclSRTs], SRTEntry)
    forall a. HasCallStack => String -> a
    panic String
    "buildSRT: empty"
        ([SRTEntry]
    these, []) -> do
          (decl,lbl) <- Profile -> [SRTEntry] -> UniqSM (CmmDeclSRTs, SRTEntry)
    buildSRT Profile
    profile [SRTEntry]
    these
          return ([decl], lbl)
        (SRTEntry
    this:[SRTEntry]
    these,[SRTEntry]
    those) -> do
          (rest, rest_lbl) <- Profile -> [SRTEntry] -> UniqSM ([CmmDeclSRTs], SRTEntry)
    buildSRTChain Profile
    profile (SRTEntry
    this SRTEntry -> [SRTEntry] -> [SRTEntry]
    forall a. a -> [a] -> [a]
    : [SRTEntry]
    those)
          (decl,lbl) <- buildSRT profile (rest_lbl : these)
          return (decl:rest, lbl)
      where
        mAX_SRT_SIZE :: WordOff
    mAX_SRT_SIZE = WordOff
    16

    buildSRT :: Profile -> [SRTEntry] -> UniqSM (CmmDeclSRTs, SRTEntry)
    buildSRT :: Profile -> [SRTEntry] -> UniqSM (CmmDeclSRTs, SRTEntry)
    buildSRT Profile
    profile [SRTEntry]
    refs = do
      id <- UniqSM Unique
    forall (m :: * -> *). MonadUnique m => m Unique
    getUniqueM
      let
        lbl = Unique -> CLabel
    mkSRTLabel Unique
    id
        platform = Profile -> Platform
    profilePlatform Profile
    profile
        srt_n_info = WordOff -> CLabel
    mkSRTInfoLabel ([SRTEntry] -> WordOff
    forall a. [a] -> WordOff
    forall (t :: * -> *) a. Foldable t => t a -> WordOff
    length [SRTEntry]
    refs)
        fields =
          Profile
    -> CLabel
    -> CostCentreStack
    -> [CmmLit]
    -> [CmmLit]
    -> [CmmLit]
    -> [CmmLit]
    -> [CmmLit]
    -> [CmmLit]
    mkStaticClosure Profile
    profile CLabel
    srt_n_info CostCentreStack
    dontCareCCS
            [ CLabel -> CmmLit
    CmmLabel CLabel
    lbl | SRTEntry CLabel
    lbl <- [SRTEntry]
    refs ]
            [] -- no padding
            [Platform -> WordOff -> CmmLit
    mkIntCLit Platform
    platform WordOff
    0] -- link field
            [] -- no saved info
            [] -- no extras
      return (mkDataLits (Section Data lbl) lbl fields, SRTEntry lbl)

    -- | Update info tables with references to their SRTs. Also generate
    -- static closures, splicing in SRT fields as necessary.
    updInfoSRTs
      :: Profile
      -> LabelMap CLabel               -- ^ SRT labels for each block
      -> LabelMap [SRTEntry]           -- ^ SRTs to merge into FUN_STATIC closures
      -> CafInfo                       -- ^ Whether the CmmDecl's group has CAF references
      -> CmmDecl
      -> [CmmDeclSRTs]

    updInfoSRTs :: Profile
    -> LabelMap CLabel
    -> LabelMap [SRTEntry]
    -> CafInfo
    -> CmmDecl
    -> [CmmDeclSRTs]
    updInfoSRTs Profile
    _ LabelMap CLabel
    _ LabelMap [SRTEntry]
    _ CafInfo
    _ (CmmData Section
    s (CmmStaticsRaw CLabel
    lbl [CmmStatic]
    statics))
      = [Section -> RawCmmStatics -> CmmDeclSRTs
    forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData Section
    s (CLabel -> [CmmStatic] -> RawCmmStatics
    forall (rawOnly :: Bool).
    CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
    CmmStaticsRaw CLabel
    lbl [CmmStatic]
    statics)]

    updInfoSRTs Profile
    profile LabelMap CLabel
    _ LabelMap [SRTEntry]
    _ CafInfo
    caffy (CmmData Section
    s (CmmStatics CLabel
    lbl CmmInfoTable
    itbl CostCentreStack
    ccs [CmmLit]
    payload [CmmLit]
    extras))
      = [Section -> RawCmmStatics -> CmmDeclSRTs
    forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData Section
    s (CLabel -> [CmmStatic] -> RawCmmStatics
    forall (rawOnly :: Bool).
    CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
    CmmStaticsRaw CLabel
    lbl ((CmmLit -> CmmStatic) -> [CmmLit] -> [CmmStatic]
    forall a b. (a -> b) -> [a] -> [b]
    map CmmLit -> CmmStatic
    CmmStaticLit [CmmLit]
    field_lits))]
      where
        field_lits :: [CmmLit]
    field_lits = Profile
    -> CmmInfoTable
    -> CostCentreStack
    -> CafInfo
    -> [CmmLit]
    -> [CmmLit]
    -> [CmmLit]
    mkStaticClosureFields Profile
    profile CmmInfoTable
    itbl CostCentreStack
    ccs CafInfo
    caffy [CmmLit]
    payload [CmmLit]
    extras

    updInfoSRTs Profile
    profile LabelMap CLabel
    srt_env LabelMap [SRTEntry]
    funSRTEnv CafInfo
    caffy (CmmProc CmmTopInfo
    top_info CLabel
    top_l [GlobalReg]
    live GenCmmGraph CmmNode
    g)
      | Just (CmmInfoTable
    _,CmmDeclSRTs
    closure) <- Maybe (CmmInfoTable, CmmDeclSRTs)
    maybeStaticClosure = [ CmmDeclSRTs
    proc, CmmDeclSRTs
    closure ]
      | Bool
    otherwise = [ CmmDeclSRTs
    proc ]
      where
        proc :: CmmDeclSRTs
    proc = CmmTopInfo
    -> CLabel -> [GlobalReg] -> GenCmmGraph CmmNode -> CmmDeclSRTs
    forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc CmmTopInfo
    top_info { info_tbls = newTopInfo } CLabel
    top_l [GlobalReg]
    live GenCmmGraph CmmNode
    g
        newTopInfo :: LabelMap CmmInfoTable
    newTopInfo = (BlockId -> CmmInfoTable -> CmmInfoTable)
    -> LabelMap CmmInfoTable -> LabelMap CmmInfoTable
    forall a v. (BlockId -> a -> v) -> LabelMap a -> LabelMap v
    mapMapWithKey BlockId -> CmmInfoTable -> CmmInfoTable
    updInfoTbl (CmmTopInfo -> LabelMap CmmInfoTable
    info_tbls CmmTopInfo
    top_info)
        updInfoTbl :: BlockId -> CmmInfoTable -> CmmInfoTable
    updInfoTbl BlockId
    l CmmInfoTable
    info_tbl
          | BlockId
    l BlockId -> BlockId -> Bool
    forall a. Eq a => a -> a -> Bool
    == GenCmmGraph CmmNode -> BlockId
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> BlockId
    g_entry GenCmmGraph CmmNode
    g, Just (CmmInfoTable
    inf, CmmDeclSRTs
    _) <- Maybe (CmmInfoTable, CmmDeclSRTs)
    maybeStaticClosure = CmmInfoTable
    inf
          | Bool
    otherwise  = CmmInfoTable
    info_tbl { cit_srt = mapLookup l srt_env }

        -- Generate static closures [FUN].  Note that this also generates
        -- static closures for thunks (CAFs), because it's easier to treat
        -- them uniformly in the code generator.
        maybeStaticClosure :: Maybe (CmmInfoTable, CmmDeclSRTs)
        maybeStaticClosure :: Maybe (CmmInfoTable, CmmDeclSRTs)
    maybeStaticClosure
          | Just info_tbl :: CmmInfoTable
    info_tbl@CmmInfoTable{Maybe (Id, CostCentreStack)
    Maybe CLabel
    CLabel
    SMRep
    ProfilingInfo
    cit_rep :: CmmInfoTable -> SMRep
    cit_lbl :: CmmInfoTable -> CLabel
    cit_clo :: CmmInfoTable -> Maybe (Id, CostCentreStack)
    cit_srt :: CmmInfoTable -> Maybe CLabel
    cit_lbl :: CLabel
    cit_rep :: SMRep
    cit_prof :: ProfilingInfo
    cit_srt :: Maybe CLabel
    cit_clo :: Maybe (Id, CostCentreStack)
    cit_prof :: CmmInfoTable -> ProfilingInfo
    ..} <-
               BlockId -> LabelMap CmmInfoTable -> Maybe CmmInfoTable
    forall f. BlockId -> FactBase f -> Maybe f
    mapLookup (GenCmmGraph CmmNode -> BlockId
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> BlockId
    g_entry GenCmmGraph CmmNode
    g) (CmmTopInfo -> LabelMap CmmInfoTable
    info_tbls CmmTopInfo
    top_info)
          , Just (Id
    id, CostCentreStack
    ccs) <- Maybe (Id, CostCentreStack)
    cit_clo
          , SMRep -> Bool
    isStaticRep SMRep
    cit_rep =
            let
              (CmmInfoTable
    newInfo, [CmmLit]
    srtEntries) = case BlockId -> LabelMap [SRTEntry] -> Maybe [SRTEntry]
    forall f. BlockId -> FactBase f -> Maybe f
    mapLookup (GenCmmGraph CmmNode -> BlockId
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> BlockId
    g_entry GenCmmGraph CmmNode
    g) LabelMap [SRTEntry]
    funSRTEnv of
                Maybe [SRTEntry]
    Nothing ->
                  -- if we don't add SRT entries to this closure, then we
                  -- want to set the srt field in its info table as usual
                  (CmmInfoTable
    info_tbl { cit_srt = mapLookup (g_entry g) srt_env }, [])
                Just [SRTEntry]
    srtEntries -> String
    -> SDoc -> (CmmInfoTable, [CmmLit]) -> (CmmInfoTable, [CmmLit])
    forall b. String -> SDoc -> b -> b
    srtTrace String
    "maybeStaticFun" (Platform -> [CmmLit] -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc (Profile -> Platform
    profilePlatform Profile
    profile) [CmmLit]
    res)
                  (CmmInfoTable
    info_tbl { cit_rep = new_rep }, [CmmLit]
    res)
                  where res :: [CmmLit]
    res = [ CLabel -> CmmLit
    CmmLabel CLabel
    lbl | SRTEntry CLabel
    lbl <- [SRTEntry]
    srtEntries ]
              fields :: [CmmLit]
    fields = Profile
    -> CmmInfoTable
    -> CostCentreStack
    -> CafInfo
    -> [CmmLit]
    -> [CmmLit]
    -> [CmmLit]
    mkStaticClosureFields Profile
    profile CmmInfoTable
    info_tbl CostCentreStack
    ccs CafInfo
    caffy [CmmLit]
    srtEntries []
              new_rep :: SMRep
    new_rep = case SMRep
    cit_rep of
                 HeapRep Bool
    sta WordOff
    ptrs WordOff
    nptrs ClosureTypeInfo
    ty ->
                   Bool -> WordOff -> WordOff -> ClosureTypeInfo -> SMRep
    HeapRep Bool
    sta (WordOff
    ptrs WordOff -> WordOff -> WordOff
    forall a. Num a => a -> a -> a
    + [CmmLit] -> WordOff
    forall a. [a] -> WordOff
    forall (t :: * -> *) a. Foldable t => t a -> WordOff
    length [CmmLit]
    srtEntries) WordOff
    nptrs ClosureTypeInfo
    ty
                 SMRep
    _other -> String -> SMRep
    forall a. HasCallStack => String -> a
    panic String
    "maybeStaticFun"
              lbl :: CLabel
    lbl = Name -> CafInfo -> CLabel
    mkClosureLabel (Id -> Name
    idName Id
    id) CafInfo
    caffy
            in
              (CmmInfoTable, CmmDeclSRTs) -> Maybe (CmmInfoTable, CmmDeclSRTs)
    forall a. a -> Maybe a
    Just (CmmInfoTable
    newInfo, Section -> CLabel -> [CmmLit] -> CmmDeclSRTs
    forall (raw :: Bool) info stmt.
    Section
    -> CLabel -> [CmmLit] -> GenCmmDecl (GenCmmStatics raw) info stmt
    mkDataLits (SectionType -> CLabel -> Section
    Section SectionType
    Data CLabel
    lbl) CLabel
    lbl [CmmLit]
    fields)
          | Bool
    otherwise = Maybe (CmmInfoTable, CmmDeclSRTs)
    forall a. Maybe a
    Nothing

    srtTrace :: String -> SDoc -> b -> b
    -- srtTrace = pprTrace
    srtTrace :: forall b. String -> SDoc -> b -> b
    srtTrace String
    _ SDoc
    _ b
    b = b
    b

    srtTraceM :: Applicative f => String -> SDoc -> f ()
    srtTraceM :: forall (f :: * -> *). Applicative f => String -> SDoc -> f ()
    srtTraceM String
    str SDoc
    doc = String -> SDoc -> f () -> f ()
    forall b. String -> SDoc -> b -> b
    srtTrace String
    str SDoc
    doc (() -> f ()
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ())