    -- | 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);
    -- >
    -- > }
    --

    {-# LANGUAGE ViewPatterns, TupleSections #-}
    module GHC.Iface.Tidy.StaticPtrTable
        ( sptCreateStaticBinds
        , sptModuleInitCode
        ) 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.Cmm.CLabel
    import GHC.Core
    import GHC.Core.Utils (collectMakeStaticArgs)
    import GHC.Core.DataCon
    import GHC.Driver.Session
    import GHC.Driver.Types
    import GHC.Types.Id
    import GHC.Core.Make (mkStringExprFSWith)
    import GHC.Unit.Module
    import GHC.Types.Name
    import GHC.Utils.Outputable as Outputable
    import GHC.Platform
    import GHC.Builtin.Names
    import GHC.Tc.Utils.Env (lookupGlobal)
    import GHC.Core.Type

    import Control.Monad.Trans.Class (lift)
    import Control.Monad.Trans.State
    import Data.List
    import Data.Maybe
    import GHC.Fingerprint
    import qualified GHC.LanguageExtensions as LangExt

    -- | 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 :: HscEnv -> Module -> CoreProgram
                         -> IO ([SptEntry], CoreProgram)
    sptCreateStaticBinds :: HscEnv -> Module -> CoreProgram -> IO ([SptEntry], CoreProgram)
    sptCreateStaticBinds HscEnv
    hsc_env Module
    this_mod CoreProgram
    binds
        | Bool -> Bool
    not (Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.StaticPointers DynFlags
    dflags) =
          ([SptEntry], CoreProgram) -> IO ([SptEntry], CoreProgram)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], CoreProgram
    binds)
        | Bool
    otherwise = do
          -- Make sure the required interface files are loaded.
          TyThing
    _ <- HscEnv -> Name -> IO TyThing
    lookupGlobal HscEnv
    hsc_env Name
    unpackCStringName
          ([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
          ([SptEntry], CoreProgram) -> IO ([SptEntry], CoreProgram)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([SptEntry]
    fps, 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 (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'

        dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
        platform :: Platform
    platform = DynFlags -> Platform
    targetPlatform DynFlags
    dflags

        -- 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 CoreExpr
    e) = do (Maybe SptEntry
    mfp, (CoreBndr
    b', CoreExpr
    e')) <- CoreBndr
    -> CoreExpr -> StateT Int IO (Maybe SptEntry, (CoreBndr, CoreExpr))
    replaceStatic CoreBndr
    b CoreExpr
    e
                                            ([SptEntry], CoreBind) -> StateT Int IO ([SptEntry], CoreBind)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe SptEntry -> [SptEntry]
    forall a. Maybe a -> [a]
    maybeToList Maybe SptEntry
    mfp, CoreBndr -> CoreExpr -> CoreBind
    forall b. b -> Expr b -> Bind b
    NonRec CoreBndr
    b' CoreExpr
    e')
        replaceStaticBind (Rec [(CoreBndr, CoreExpr)]
    rbs) = do
          ([Maybe SptEntry]
    mfps, [(CoreBndr, CoreExpr)]
    rbs') <- [(Maybe SptEntry, (CoreBndr, CoreExpr))]
    -> ([Maybe SptEntry], [(CoreBndr, CoreExpr)])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(Maybe SptEntry, (CoreBndr, CoreExpr))]
     -> ([Maybe SptEntry], [(CoreBndr, CoreExpr)]))
    -> StateT Int IO [(Maybe SptEntry, (CoreBndr, CoreExpr))]
    -> StateT Int IO ([Maybe SptEntry], [(CoreBndr, CoreExpr)])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((CoreBndr, CoreExpr)
     -> StateT Int IO (Maybe SptEntry, (CoreBndr, CoreExpr)))
    -> [(CoreBndr, CoreExpr)]
    -> StateT Int IO [(Maybe SptEntry, (CoreBndr, CoreExpr))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((CoreBndr
     -> CoreExpr
     -> StateT Int IO (Maybe SptEntry, (CoreBndr, CoreExpr)))
    -> (CoreBndr, CoreExpr)
    -> StateT Int IO (Maybe SptEntry, (CoreBndr, CoreExpr))
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry CoreBndr
    -> CoreExpr -> StateT Int IO (Maybe SptEntry, (CoreBndr, CoreExpr))
    replaceStatic) [(CoreBndr, CoreExpr)]
    rbs
          ([SptEntry], CoreBind) -> StateT Int IO ([SptEntry], CoreBind)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Maybe SptEntry] -> [SptEntry]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe SptEntry]
    mfps, [(CoreBndr, CoreExpr)] -> CoreBind
    forall b. [(b, Expr b)] -> Bind b
    Rec [(CoreBndr, CoreExpr)]
    rbs')

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

        mkStaticBind :: Type -> CoreExpr -> CoreExpr
                     -> StateT Int IO (Fingerprint, CoreExpr)
        mkStaticBind :: Type
    -> CoreExpr -> CoreExpr -> StateT Int IO (Fingerprint, CoreExpr)
    mkStaticBind Type
    t CoreExpr
    srcLoc CoreExpr
    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)
          DataCon
    staticPtrInfoDataCon <-
            IO DataCon -> StateT Int IO DataCon
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO DataCon -> StateT Int IO DataCon)
    -> IO DataCon -> StateT Int IO DataCon
    forall a b. (a -> b) -> a -> b
    $ Name -> IO DataCon
    lookupDataConHscEnv Name
    staticPtrInfoDataConName
          let fp :: Fingerprint
    fp@(Fingerprint Word64
    w0 Word64
    w1) = Int -> Fingerprint
    mkStaticPtrFingerprint Int
    i
          CoreExpr
    info <- DataCon -> [CoreExpr] -> CoreExpr
    forall b. DataCon -> [Arg b] -> Arg b
    mkConApp DataCon
    staticPtrInfoDataCon ([CoreExpr] -> CoreExpr)
    -> ([CoreExpr] -> [CoreExpr]) -> [CoreExpr] -> CoreExpr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                ([CoreExpr] -> [CoreExpr] -> [CoreExpr]
    forall a. [a] -> [a] -> [a]
    ++[CoreExpr
    srcLoc]) ([CoreExpr] -> CoreExpr)
    -> StateT Int IO [CoreExpr] -> StateT Int IO CoreExpr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                (FastString -> StateT Int IO CoreExpr)
    -> [FastString] -> StateT Int IO [CoreExpr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((Name -> StateT Int IO CoreBndr)
    -> FastString -> StateT Int IO CoreExpr
    forall (m :: * -> *).
    Monad m =>
    (Name -> m CoreBndr) -> FastString -> m CoreExpr
    mkStringExprFSWith (IO CoreBndr -> StateT Int IO CoreBndr
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO CoreBndr -> StateT Int IO CoreBndr)
    -> (Name -> IO CoreBndr) -> Name -> StateT Int IO CoreBndr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> IO CoreBndr
    lookupIdHscEnv))
                     [ Unit -> FastString
    unitFS (Unit -> FastString) -> Unit -> FastString
    forall a b. (a -> b) -> a -> b
    $ Module -> Unit
    forall unit. GenModule unit -> unit
    moduleUnit Module
    this_mod
                     , 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
                     ]

          -- The module interface of GHC.StaticPtr should be loaded at least
          -- when looking up 'fromStatic' during type-checking.
          DataCon
    staticPtrDataCon <- IO DataCon -> StateT Int IO DataCon
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO DataCon -> StateT Int IO DataCon)
    -> IO DataCon -> StateT Int IO DataCon
    forall a b. (a -> b) -> a -> b
    $ Name -> IO DataCon
    lookupDataConHscEnv Name
    staticPtrDataConName
          (Fingerprint, CoreExpr) -> StateT Int IO (Fingerprint, CoreExpr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Fingerprint
    fp, DataCon -> [CoreExpr] -> CoreExpr
    forall b. DataCon -> [Arg b] -> Arg b
    mkConApp DataCon
    staticPtrDataCon
                                   [ Type -> CoreExpr
    forall b. Type -> Expr b
    Type Type
    t
                                   , Platform -> Word64 -> CoreExpr
    forall {b}. Platform -> Word64 -> Expr b
    mkWord64LitWordRep Platform
    platform Word64
    w0
                                   , Platform -> Word64 -> CoreExpr
    forall {b}. Platform -> Word64 -> Expr b
    mkWord64LitWordRep Platform
    platform Word64
    w1
                                   , CoreExpr
    info
                                   , CoreExpr
    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
    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
            ]

        -- Choose either 'Word64#' or 'Word#' to represent the arguments of the
        -- 'Fingerprint' data constructor.
        mkWord64LitWordRep :: Platform -> Word64 -> Expr b
    mkWord64LitWordRep Platform
    platform =
          case Platform -> PlatformWordSize
    platformWordSize Platform
    platform of
            PlatformWordSize
    PW4 -> Word64 -> Expr b
    forall b. Word64 -> Expr b
    mkWord64LitWord64
            PlatformWordSize
    PW8 -> Platform -> Integer -> Expr b
    forall b. Platform -> Integer -> Expr b
    mkWordLit Platform
    platform (Integer -> Expr b) -> (Word64 -> Integer) -> Word64 -> Expr b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word64 -> Integer
    forall a. Integral a => a -> Integer
    toInteger

        lookupIdHscEnv :: Name -> IO Id
        lookupIdHscEnv :: Name -> IO CoreBndr
    lookupIdHscEnv Name
    n = HscEnv -> Name -> IO (Maybe TyThing)
    lookupTypeHscEnv HscEnv
    hsc_env Name
    n IO (Maybe TyThing) -> (Maybe TyThing -> IO CoreBndr) -> IO CoreBndr
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                             IO CoreBndr
    -> (TyThing -> IO CoreBndr) -> Maybe TyThing -> IO CoreBndr
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Name -> IO CoreBndr
    forall {a} {a}. Outputable a => a -> a
    getError Name
    n) (CoreBndr -> IO CoreBndr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreBndr -> IO CoreBndr)
    -> (TyThing -> CoreBndr) -> TyThing -> IO CoreBndr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasDebugCallStack => TyThing -> CoreBndr
    TyThing -> CoreBndr
    tyThingId)

        lookupDataConHscEnv :: Name -> IO DataCon
        lookupDataConHscEnv :: Name -> IO DataCon
    lookupDataConHscEnv Name
    n = HscEnv -> Name -> IO (Maybe TyThing)
    lookupTypeHscEnv HscEnv
    hsc_env Name
    n IO (Maybe TyThing) -> (Maybe TyThing -> IO DataCon) -> IO DataCon
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                                  IO DataCon
    -> (TyThing -> IO DataCon) -> Maybe TyThing -> IO DataCon
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Name -> IO DataCon
    forall {a} {a}. Outputable a => a -> a
    getError Name
    n) (DataCon -> IO DataCon
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DataCon -> IO DataCon)
    -> (TyThing -> DataCon) -> TyThing -> IO DataCon
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasDebugCallStack => TyThing -> DataCon
    TyThing -> DataCon
    tyThingDataCon)

        getError :: a -> a
    getError a
    n = String -> SDoc -> a
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "sptCreateStaticBinds.get: not found" (SDoc -> a) -> SDoc -> a
    forall a b. (a -> b) -> a -> b
    $
          String -> SDoc
    text String
    "Couldn't find" SDoc -> SDoc -> SDoc
    <+> a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    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 :: Module -> [SptEntry] -> SDoc
    sptModuleInitCode :: Module -> [SptEntry] -> SDoc
    sptModuleInitCode Module
    _ [] = SDoc
    Outputable.empty
    sptModuleInitCode Module
    this_mod [SptEntry]
    entries = [SDoc] -> SDoc
    vcat
        [ String -> SDoc
    text String
    "static void hs_spt_init_" SDoc -> SDoc -> SDoc
    <> Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    this_mod
               SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    "(void) __attribute__((constructor));"
        , String -> SDoc
    text String
    "static void hs_spt_init_" SDoc -> SDoc -> SDoc
    <> Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    this_mod SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    "(void)"
        , SDoc -> SDoc
    braces (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $
            [  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
    <> (CLabel -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (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
    <> CLabel -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (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
            ]
        , String -> SDoc
    text String
    "static void hs_spt_fini_" SDoc -> SDoc -> SDoc
    <> Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    this_mod
               SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    "(void) __attribute__((destructor));"
        , String -> SDoc
    text String
    "static void hs_spt_fini_" SDoc -> SDoc -> SDoc
    <> Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    this_mod SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    "(void)"
        , SDoc -> SDoc
    braces (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $
            [  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
            ]
        ]
      where
        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"
                     ]