    {-# LANGUAGE ViewPatterns #-}

    -- | Code generation for the Static Pointer Table
    --
    -- (c) 2014 I/O Tweag
    --
    -- Each module that uses 'static' keyword declares an initialization function of
    -- the form hs_spt_init_\<module>() which is emitted into the _stub.c file and
    -- annotated with __attribute__((constructor)) so that it gets executed at
    -- startup time.
    --
    -- The function's purpose is to call hs_spt_insert to insert the static
    -- pointers of this module in the hashtable of the RTS, and it looks something
    -- like this:
    --
    -- > static void hs_hpc_init_Main(void) __attribute__((constructor));
    -- > static void hs_hpc_init_Main(void) {
    -- >
    -- >   static StgWord64 k0[2] = {16252233372134256ULL,7370534374096082ULL};
    -- >   extern StgPtr Main_r2wb_closure;
    -- >   hs_spt_insert(k0, &Main_r2wb_closure);
    -- >
    -- >   static StgWord64 k1[2] = {12545634534567898ULL,5409674567544151ULL};
    -- >   extern StgPtr Main_r2wc_closure;
    -- >   hs_spt_insert(k1, &Main_r2wc_closure);
    -- >
    -- > }
    --
    -- where the constants are fingerprints produced from the static forms.
    --
    -- The linker must find the definitions matching the @extern StgPtr <name>@
    -- declarations. For this to work, the identifiers of static pointers need to be
    -- exported. This is done in 'GHC.Core.Opt.SetLevels.newLvlVar'.
    --
    -- There is also a finalization function for the time when the module is
    -- unloaded.
    --
    -- > static void hs_hpc_fini_Main(void) __attribute__((destructor));
    -- > static void hs_hpc_fini_Main(void) {
    -- >
    -- >   static StgWord64 k0[2] = {16252233372134256ULL,7370534374096082ULL};
    -- >   hs_spt_remove(k0);
    -- >
    -- >   static StgWord64 k1[2] = {12545634534567898ULL,5409674567544151ULL};
    -- >   hs_spt_remove(k1);
    -- >
    -- > }
    --

    module GHC.Iface.Tidy.StaticPtrTable
      ( sptCreateStaticBinds
      , sptModuleInitCode
      , StaticPtrOpts (..)
      )
    where

    {- Note [Grand plan for static forms]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Static forms go through the compilation phases as follows.
    Here is a running example:

       f x = let k = map toUpper
             in ...(static k)...

    * The renamer looks for out-of-scope names in the body of the static
      form, as always. If all names are in scope, the free variables of the
      body are stored in AST at the location of the static form.

    * The typechecker verifies that all free variables occurring in the
      static form are floatable to top level (see Note [Meaning of
      IdBindingInfo] in GHC.Tc.Types).  In our example, 'k' is floatable.
      Even though it is bound in a nested let, we are fine.

    * The desugarer replaces the static form with an application of the
      function 'makeStatic' (defined in module GHC.StaticPtr.Internal of
      base).  So we get

       f x = let k = map toUpper
             in ...fromStaticPtr (makeStatic location k)...

    * The simplifier runs the FloatOut pass which moves the calls to 'makeStatic'
      to the top level. Thus the FloatOut pass is always executed, even when
      optimizations are disabled.  So we get

       k = map toUpper
       static_ptr = makeStatic location k
       f x = ...fromStaticPtr static_ptr...

      The FloatOut pass is careful to produce an /exported/ Id for a floated
      'makeStatic' call, so the binding is not removed or inlined by the
      simplifier.
      E.g. the code for `f` above might look like

        static_ptr = makeStatic location k
        f x = ...(case static_ptr of ...)...

      which might be simplified to

        f x = ...(case makeStatic location k of ...)...

      BUT the top-level binding for static_ptr must remain, so that it can be
      collected to populate the Static Pointer Table.

      Making the binding exported also has a necessary effect during the
      CoreTidy pass.

    * The CoreTidy pass replaces all bindings of the form

      b = /\ ... -> makeStatic location value

      with

      b = /\ ... -> StaticPtr key (StaticPtrInfo "pkg key" "module" location) value

      where a distinct key is generated for each binding.

    * If we are compiling to object code we insert a C stub (generated by
      sptModuleInitCode) into the final object which runs when the module is loaded,
      inserting the static forms defined by the module into the RTS's static pointer
      table.

    * If we are compiling for the byte-code interpreter, we instead explicitly add
      the SPT entries (recorded in CgGuts' cg_spt_entries field) to the interpreter
      process' SPT table using the addSptEntry interpreter message. This happens
      in upsweep after we have compiled the module (see GHC.Driver.Make.upsweep').
    -}

    import GHC.Prelude
    import GHC.Platform

    import GHC.Core
    import GHC.Core.Utils (collectMakeStaticArgs)
    import GHC.Core.DataCon
    import GHC.Core.Make (mkStringExprFSWith,MkStringIds(..))
    import GHC.Core.Type

    import GHC.Cmm.CLabel

    import GHC.Unit.Module
    import GHC.Utils.Outputable as Outputable

    import GHC.Linker.Types

    import GHC.Types.Id
    import GHC.Types.ForeignStubs
    import GHC.Data.Maybe

    import Control.Monad.Trans.State.Strict
    import Data.List (intercalate)
    import GHC.Fingerprint

    data StaticPtrOpts = StaticPtrOpts
      { StaticPtrOpts -> Platform
    opt_platform                :: !Platform    -- ^ Target platform
      , StaticPtrOpts -> Bool
    opt_gen_cstub               :: !Bool        -- ^ Generate CStub or not
      , StaticPtrOpts -> MkStringIds
    opt_mk_string               :: !MkStringIds -- ^ Ids for `unpackCString[Utf8]#`
      , StaticPtrOpts -> DataCon
    opt_static_ptr_info_datacon :: !DataCon          -- ^ `StaticPtrInfo` datacon
      , StaticPtrOpts -> DataCon
    opt_static_ptr_datacon      :: !DataCon          -- ^ `StaticPtr` datacon
      }

    -- | Replaces all bindings of the form
    --
    -- > b = /\ ... -> makeStatic location value
    --
    --  with
    --
    -- > b = /\ ... ->
    -- >   StaticPtr key (StaticPtrInfo "pkg key" "module" location) value
    --
    --  where a distinct key is generated for each binding.
    --
    -- It also yields the C stub that inserts these bindings into the static
    -- pointer table.
    sptCreateStaticBinds :: StaticPtrOpts -> Module -> CoreProgram -> IO ([SptEntry], Maybe CStub, CoreProgram)
    sptCreateStaticBinds :: StaticPtrOpts
    -> Module
    -> CoreProgram
    -> IO ([SptEntry], Maybe CStub, CoreProgram)
    sptCreateStaticBinds StaticPtrOpts
    opts Module
    this_mod CoreProgram
    binds = do
          ([SptEntry]
    fps, CoreProgram
    binds') <- StateT Int IO ([SptEntry], CoreProgram)
    -> Int -> IO ([SptEntry], CoreProgram)
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT ([SptEntry]
    -> CoreProgram
    -> CoreProgram
    -> StateT Int IO ([SptEntry], CoreProgram)
    go [] [] CoreProgram
    binds) Int
    0
          let cstub :: Maybe CStub
    cstub
                | StaticPtrOpts -> Bool
    opt_gen_cstub StaticPtrOpts
    opts = CStub -> Maybe CStub
    forall a. a -> Maybe a
    Just (Platform -> Module -> [SptEntry] -> CStub
    sptModuleInitCode (StaticPtrOpts -> Platform
    opt_platform StaticPtrOpts
    opts) Module
    this_mod [SptEntry]
    fps)
                | Bool
    otherwise          = Maybe CStub
    forall a. Maybe a
    Nothing
          ([SptEntry], Maybe CStub, CoreProgram)
    -> IO ([SptEntry], Maybe CStub, CoreProgram)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([SptEntry]
    fps, Maybe CStub
    cstub, CoreProgram
    binds')
      where
        go :: [SptEntry]
    -> CoreProgram
    -> CoreProgram
    -> StateT Int IO ([SptEntry], CoreProgram)
    go [SptEntry]
    fps CoreProgram
    bs CoreProgram
    xs = case CoreProgram
    xs of
          []        -> ([SptEntry], CoreProgram)
    -> StateT Int IO ([SptEntry], CoreProgram)
    forall a. a -> StateT Int IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([SptEntry] -> [SptEntry]
    forall a. [a] -> [a]
    reverse [SptEntry]
    fps, CoreProgram -> CoreProgram
    forall a. [a] -> [a]
    reverse CoreProgram
    bs)
          CoreBind
    bnd : CoreProgram
    xs' -> do
            ([SptEntry]
    fps', CoreBind
    bnd') <- CoreBind -> StateT Int IO ([SptEntry], CoreBind)
    replaceStaticBind CoreBind
    bnd
            [SptEntry]
    -> CoreProgram
    -> CoreProgram
    -> StateT Int IO ([SptEntry], CoreProgram)
    go ([SptEntry] -> [SptEntry]
    forall a. [a] -> [a]
    reverse [SptEntry]
    fps' [SptEntry] -> [SptEntry] -> [SptEntry]
    forall a. [a] -> [a] -> [a]
    ++ [SptEntry]
    fps) (CoreBind
    bnd' CoreBind -> CoreProgram -> CoreProgram
    forall a. a -> [a] -> [a]
    : CoreProgram
    bs) CoreProgram
    xs'

        -- Generates keys and replaces 'makeStatic' with 'StaticPtr'.
        --
        -- The 'Int' state is used to produce a different key for each binding.
        replaceStaticBind :: CoreBind
                          -> StateT Int IO ([SptEntry], CoreBind)
        replaceStaticBind :: CoreBind -> StateT Int IO ([SptEntry], CoreBind)
    replaceStaticBind (NonRec CoreBndr
    b Expr CoreBndr
    e) = do (Maybe SptEntry
    mfp, (CoreBndr
    b', Expr CoreBndr
    e')) <- CoreBndr
    -> Expr CoreBndr
    -> StateT Int IO (Maybe SptEntry, (CoreBndr, Expr CoreBndr))
    replaceStatic CoreBndr
    b Expr CoreBndr
    e
                                            ([SptEntry], CoreBind) -> StateT Int IO ([SptEntry], CoreBind)
    forall a. a -> StateT Int IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe SptEntry -> [SptEntry]
    forall a. Maybe a -> [a]
    maybeToList Maybe SptEntry
    mfp, CoreBndr -> Expr CoreBndr -> CoreBind
    forall b. b -> Expr b -> Bind b
    NonRec CoreBndr
    b' Expr CoreBndr
    e')
        replaceStaticBind (Rec [(CoreBndr, Expr CoreBndr)]
    rbs) = do
          ([Maybe SptEntry]
    mfps, [(CoreBndr, Expr CoreBndr)]
    rbs') <- [(Maybe SptEntry, (CoreBndr, Expr CoreBndr))]
    -> ([Maybe SptEntry], [(CoreBndr, Expr CoreBndr)])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(Maybe SptEntry, (CoreBndr, Expr CoreBndr))]
     -> ([Maybe SptEntry], [(CoreBndr, Expr CoreBndr)]))
    -> StateT Int IO [(Maybe SptEntry, (CoreBndr, Expr CoreBndr))]
    -> StateT Int IO ([Maybe SptEntry], [(CoreBndr, Expr CoreBndr)])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((CoreBndr, Expr CoreBndr)
     -> StateT Int IO (Maybe SptEntry, (CoreBndr, Expr CoreBndr)))
    -> [(CoreBndr, Expr CoreBndr)]
    -> StateT Int IO [(Maybe SptEntry, (CoreBndr, Expr CoreBndr))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ((CoreBndr
     -> Expr CoreBndr
     -> StateT Int IO (Maybe SptEntry, (CoreBndr, Expr CoreBndr)))
    -> (CoreBndr, Expr CoreBndr)
    -> StateT Int IO (Maybe SptEntry, (CoreBndr, Expr CoreBndr))
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry CoreBndr
    -> Expr CoreBndr
    -> StateT Int IO (Maybe SptEntry, (CoreBndr, Expr CoreBndr))
    replaceStatic) [(CoreBndr, Expr CoreBndr)]
    rbs
          ([SptEntry], CoreBind) -> StateT Int IO ([SptEntry], CoreBind)
    forall a. a -> StateT Int IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Maybe SptEntry] -> [SptEntry]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe SptEntry]
    mfps, [(CoreBndr, Expr CoreBndr)] -> CoreBind
    forall b. [(b, Expr b)] -> Bind b
    Rec [(CoreBndr, Expr CoreBndr)]
    rbs')

        replaceStatic :: Id -> CoreExpr
                      -> StateT Int IO (Maybe SptEntry, (Id, CoreExpr))
        replaceStatic :: CoreBndr
    -> Expr CoreBndr
    -> StateT Int IO (Maybe SptEntry, (CoreBndr, Expr CoreBndr))
    replaceStatic CoreBndr
    b e :: Expr CoreBndr
    e@(Expr CoreBndr -> ([CoreBndr], Expr CoreBndr)
    collectTyBinders -> ([CoreBndr]
    tvs, Expr CoreBndr
    e0)) =
          case Expr CoreBndr
    -> Maybe (Expr CoreBndr, Type, Expr CoreBndr, Expr CoreBndr)
    collectMakeStaticArgs Expr CoreBndr
    e0 of
            Maybe (Expr CoreBndr, Type, Expr CoreBndr, Expr CoreBndr)
    Nothing      -> (Maybe SptEntry, (CoreBndr, Expr CoreBndr))
    -> StateT Int IO (Maybe SptEntry, (CoreBndr, Expr CoreBndr))
    forall a. a -> StateT Int IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe SptEntry
    forall a. Maybe a
    Nothing, (CoreBndr
    b, Expr CoreBndr
    e))
            Just (Expr CoreBndr
    _, Type
    t, Expr CoreBndr
    info, Expr CoreBndr
    arg) -> do
              (Fingerprint
    fp, Expr CoreBndr
    e') <- Type
    -> Expr CoreBndr
    -> Expr CoreBndr
    -> StateT Int IO (Fingerprint, Expr CoreBndr)
    mkStaticBind Type
    t Expr CoreBndr
    info Expr CoreBndr
    arg
              (Maybe SptEntry, (CoreBndr, Expr CoreBndr))
    -> StateT Int IO (Maybe SptEntry, (CoreBndr, Expr CoreBndr))
    forall a. a -> StateT Int IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SptEntry -> Maybe SptEntry
    forall a. a -> Maybe a
    Just (CoreBndr -> Fingerprint -> SptEntry
    SptEntry CoreBndr
    b Fingerprint
    fp), (CoreBndr
    b, (CoreBndr -> Expr CoreBndr -> Expr CoreBndr)
    -> Expr CoreBndr -> [CoreBndr] -> Expr CoreBndr
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr CoreBndr -> Expr CoreBndr -> Expr CoreBndr
    forall b. b -> Expr b -> Expr b
    Lam Expr CoreBndr
    e' [CoreBndr]
    tvs))

        mkStaticBind :: Type -> CoreExpr -> CoreExpr
                     -> StateT Int IO (Fingerprint, CoreExpr)
        mkStaticBind :: Type
    -> Expr CoreBndr
    -> Expr CoreBndr
    -> StateT Int IO (Fingerprint, Expr CoreBndr)
    mkStaticBind Type
    t Expr CoreBndr
    srcLoc Expr CoreBndr
    e = do
          Int
    i <- StateT Int IO Int
    forall (m :: * -> *) s. Monad m => StateT s m s
    get
          Int -> StateT Int IO ()
    forall (m :: * -> *) s. Monad m => s -> StateT s m ()
    put (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
          let staticPtrInfoDataCon :: DataCon
    staticPtrInfoDataCon = StaticPtrOpts -> DataCon
    opt_static_ptr_info_datacon StaticPtrOpts
    opts
          let fp :: Fingerprint
    fp@(Fingerprint Word64
    w0 Word64
    w1) = Int -> Fingerprint
    mkStaticPtrFingerprint Int
    i
          let mk_string_fs :: FastString -> Expr CoreBndr
    mk_string_fs = MkStringIds -> FastString -> Expr CoreBndr
    mkStringExprFSWith (StaticPtrOpts -> MkStringIds
    opt_mk_string StaticPtrOpts
    opts)
          let info :: Expr CoreBndr
    info = DataCon -> [Expr CoreBndr] -> Expr CoreBndr
    forall b. DataCon -> [Arg b] -> Arg b
    mkConApp DataCon
    staticPtrInfoDataCon
                      [ FastString -> Expr CoreBndr
    mk_string_fs (FastString -> Expr CoreBndr) -> FastString -> Expr CoreBndr
    forall a b. (a -> b) -> a -> b
    $ Unit -> FastString
    forall u. IsUnitId u => u -> FastString
    unitFS (Unit -> FastString) -> Unit -> FastString
    forall a b. (a -> b) -> a -> b
    $ Module -> Unit
    forall unit. GenModule unit -> unit
    moduleUnit Module
    this_mod
                      , FastString -> Expr CoreBndr
    mk_string_fs (FastString -> Expr CoreBndr) -> FastString -> Expr CoreBndr
    forall a b. (a -> b) -> a -> b
    $ ModuleName -> FastString
    moduleNameFS (ModuleName -> FastString) -> ModuleName -> FastString
    forall a b. (a -> b) -> a -> b
    $ Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    this_mod
                      , Expr CoreBndr
    srcLoc
                      ]

          let staticPtrDataCon :: DataCon
    staticPtrDataCon = StaticPtrOpts -> DataCon
    opt_static_ptr_datacon StaticPtrOpts
    opts
          (Fingerprint, Expr CoreBndr)
    -> StateT Int IO (Fingerprint, Expr CoreBndr)
    forall a. a -> StateT Int IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Fingerprint
    fp, DataCon -> [Expr CoreBndr] -> Expr CoreBndr
    forall b. DataCon -> [Arg b] -> Arg b
    mkConApp DataCon
    staticPtrDataCon
                                   [ Type -> Expr CoreBndr
    forall b. Type -> Expr b
    Type Type
    t
                                   , Word64 -> Expr CoreBndr
    forall b. Word64 -> Expr b
    mkWord64LitWord64 Word64
    w0
                                   , Word64 -> Expr CoreBndr
    forall b. Word64 -> Expr b
    mkWord64LitWord64 Word64
    w1
                                   , Expr CoreBndr
    info
                                   , Expr CoreBndr
    e ])

        mkStaticPtrFingerprint :: Int -> Fingerprint
        mkStaticPtrFingerprint :: Int -> Fingerprint
    mkStaticPtrFingerprint Int
    n = String -> Fingerprint
    fingerprintString (String -> Fingerprint) -> String -> Fingerprint
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ":"
            [ Unit -> String
    forall u. IsUnitId u => u -> String
    unitString (Unit -> String) -> Unit -> String
    forall a b. (a -> b) -> a -> b
    $ Module -> Unit
    forall unit. GenModule unit -> unit
    moduleUnit Module
    this_mod
            , ModuleName -> String
    moduleNameString (ModuleName -> String) -> ModuleName -> String
    forall a b. (a -> b) -> a -> b
    $ Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    this_mod
            , Int -> String
    forall a. Show a => a -> String
    show Int
    n
            ]

    -- | @sptModuleInitCode module fps@ is a C stub to insert the static entries
    -- of @module@ into the static pointer table.
    --
    -- @fps@ is a list associating each binding corresponding to a static entry with
    -- its fingerprint.
    sptModuleInitCode :: Platform -> Module -> [SptEntry] -> CStub
    sptModuleInitCode :: Platform -> Module -> [SptEntry] -> CStub
    sptModuleInitCode Platform
    _        Module
    _        [] = CStub
    forall a. Monoid a => a
    mempty
    sptModuleInitCode Platform
    platform Module
    this_mod [SptEntry]
    entries =
        Platform -> CLabel -> SDoc -> SDoc -> CStub
    initializerCStub Platform
    platform CLabel
    init_fn_nm SDoc
    empty SDoc
    init_fn_body CStub -> CStub -> CStub
    forall a. Monoid a => a -> a -> a
    `mappend`
        Platform -> CLabel -> SDoc -> SDoc -> CStub
    finalizerCStub Platform
    platform CLabel
    fini_fn_nm SDoc
    empty SDoc
    fini_fn_body
      where
        init_fn_nm :: CLabel
    init_fn_nm = Module -> String -> CLabel
    mkInitializerStubLabel Module
    this_mod String
    "spt"
        init_fn_body :: SDoc
    init_fn_body = [SDoc] -> SDoc
    vcat
            [  String -> SDoc
    text String
    "static StgWord64 k" SDoc -> SDoc -> SDoc
    <> Int -> SDoc
    int Int
    i SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    "[2] = "
               SDoc -> SDoc -> SDoc
    <> Fingerprint -> SDoc
    pprFingerprint Fingerprint
    fp SDoc -> SDoc -> SDoc
    <> SDoc
    semi
            SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "extern StgPtr "
               SDoc -> SDoc -> SDoc
    <> (Platform -> CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform (CLabel -> SDoc) -> CLabel -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Name -> CafInfo -> CLabel
    mkClosureLabel (CoreBndr -> Name
    idName CoreBndr
    n) (CoreBndr -> CafInfo
    idCafInfo CoreBndr
    n)) SDoc -> SDoc -> SDoc
    <> SDoc
    semi
            SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "hs_spt_insert" SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    parens
                 ([SDoc] -> SDoc
    hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    comma
                    [ Char -> SDoc
    char Char
    'k' SDoc -> SDoc -> SDoc
    <> Int -> SDoc
    int Int
    i
                    , Char -> SDoc
    char Char
    '&' SDoc -> SDoc -> SDoc
    <> Platform -> CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform (Name -> CafInfo -> CLabel
    mkClosureLabel (CoreBndr -> Name
    idName CoreBndr
    n) (CoreBndr -> CafInfo
    idCafInfo CoreBndr
    n))
                    ]
                 )
            SDoc -> SDoc -> SDoc
    <> SDoc
    semi
            |  (Int
    i, SptEntry CoreBndr
    n Fingerprint
    fp) <- [Int] -> [SptEntry] -> [(Int, SptEntry)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] [SptEntry]
    entries
            ]

        fini_fn_nm :: CLabel
    fini_fn_nm = Module -> String -> CLabel
    mkFinalizerStubLabel Module
    this_mod String
    "spt"
        fini_fn_body :: SDoc
    fini_fn_body = [SDoc] -> SDoc
    vcat
            [  String -> SDoc
    text String
    "StgWord64 k" SDoc -> SDoc -> SDoc
    <> Int -> SDoc
    int Int
    i SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    "[2] = "
               SDoc -> SDoc -> SDoc
    <> Fingerprint -> SDoc
    pprFingerprint Fingerprint
    fp SDoc -> SDoc -> SDoc
    <> SDoc
    semi
            SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "hs_spt_remove" SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    parens (Char -> SDoc
    char Char
    'k' SDoc -> SDoc -> SDoc
    <> Int -> SDoc
    int Int
    i) SDoc -> SDoc -> SDoc
    <> SDoc
    semi
            | (Int
    i, (SptEntry CoreBndr
    _ Fingerprint
    fp)) <- [Int] -> [SptEntry] -> [(Int, SptEntry)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] [SptEntry]
    entries
            ]

        pprFingerprint :: Fingerprint -> SDoc
        pprFingerprint :: Fingerprint -> SDoc
    pprFingerprint (Fingerprint Word64
    w1 Word64
    w2) =
          SDoc -> SDoc
    braces (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    comma
                     [ Integer -> SDoc
    integer (Word64 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word64
    w1) SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    "ULL"
                     , Integer -> SDoc
    integer (Word64 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word64
    w2) SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    "ULL"
                     ]