Add support for StaticPointers in GHCi

Here we add support to GHCi for StaticPointers. This process begins by
adding remote GHCi messages for adding entries to the static pointer
table. We then collect binders needing SPT entries after linking and
send the interpreter a message adding entries with the appropriate
fingerprints.

Test Plan: `make test TEST=StaticPtr`

Reviewers: facundominguez, mboes, simonpj, simonmar, goldfire, austin,
hvr, erikd

Reviewed By: simonpj, simonmar

Subscribers: RyanGlScott, simonpj, thomie

Differential Revision: https://phabricator.haskell.org/D2504

GHC Trac Issues: #12356

25 files changed, 232 insertions, 53 deletions

diff --git a/compiler/ghci/GHCi.hsc b/compiler/ghci/GHCi.hsc
index 2c6860f126..849c8db7fa 100644
--- a/compiler/ghci/GHCi.hsc
+++ b/compiler/ghci/GHCi.hsc
@@ -14,6 +14,7 @@ module GHCi
   , evalStringToIOString
   , mallocData
   , createBCOs
+  , addSptEntry
   , mkCostCentres
   , costCentreStackInfo
   , newBreakArray
@@ -52,6 +53,7 @@ import GHCi.Run
 import GHCi.RemoteTypes
 import GHCi.ResolvedBCO
 import GHCi.BreakArray (BreakArray)
+import Fingerprint
 import HscTypes
 import UniqFM
 import Panic
@@ -326,6 +328,11 @@ createBCOs hsc_env rbcos = do
   parMap f (x:xs) = fx `par` (fxs `pseq` (fx : fxs))
     where fx = f x; fxs = parMap f xs
 
+addSptEntry :: HscEnv -> Fingerprint -> ForeignHValue -> IO ()
+addSptEntry hsc_env fpr ref =
+  withForeignRef ref $ \val ->
+    iservCmd hsc_env (AddSptEntry fpr val)
+
 costCentreStackInfo :: HscEnv -> RemotePtr CostCentreStack -> IO [String]
 costCentreStackInfo hsc_env ccs =
   iservCmd hsc_env (CostCentreStackInfo ccs)
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 08af37cdda..463b715807 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -182,7 +182,8 @@ compileOne' m_tc_result mHscMessage
             let linkable = LM o_time this_mod [DotO object_filename]
             return hmi0 { hm_linkable = Just linkable }
         (HscRecomp cgguts summary, HscInterpreted) -> do
-            (hasStub, comp_bc) <- hscInteractive hsc_env cgguts summary
+            (hasStub, comp_bc, spt_entries) <-
+                hscInteractive hsc_env cgguts summary
 
             stub_o <- case hasStub of
                       Nothing -> return []
@@ -190,7 +191,7 @@ compileOne' m_tc_result mHscMessage
                           stub_o <- compileStub hsc_env stub_c
                           return [DotO stub_o]
 
-            let hs_unlinked = [BCOs comp_bc]
+            let hs_unlinked = [BCOs comp_bc spt_entries]
                 unlinked_time = ms_hs_date summary
               -- Why do we use the timestamp of the source file here,
               -- rather than the current time?  This works better in
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 25c1484770..bc406d5c59 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -323,7 +323,7 @@ import Annotations
 import Module
 import Panic
 import Platform
-import Bag              ( unitBag )
+import Bag              ( listToBag, unitBag )
 import ErrUtils
 import MonadUtils
 import Util
@@ -615,7 +615,8 @@ getProgramDynFlags = getSessionDynFlags
 setInteractiveDynFlags :: GhcMonad m => DynFlags -> m ()
 setInteractiveDynFlags dflags = do
   dflags' <- checkNewDynFlags dflags
-  modifySession $ \h -> h{ hsc_IC = (hsc_IC h) { ic_dflags = dflags' }}
+  dflags'' <- checkNewInteractiveDynFlags dflags'
+  modifySession $ \h -> h{ hsc_IC = (hsc_IC h) { ic_dflags = dflags'' }}
 
 -- | Get the 'DynFlags' used to evaluate interactive expressions.
 getInteractiveDynFlags :: GhcMonad m => m DynFlags
@@ -637,6 +638,18 @@ checkNewDynFlags dflags = do
   liftIO $ handleFlagWarnings dflags warnings
   return dflags'
 
+checkNewInteractiveDynFlags :: MonadIO m => DynFlags -> m DynFlags
+checkNewInteractiveDynFlags dflags0 = do
+  dflags1 <-
+      if xopt LangExt.StaticPointers dflags0
+      then do liftIO $ printOrThrowWarnings dflags0 $ listToBag
+                [mkPlainWarnMsg dflags0 interactiveSrcSpan
+                 $ text "StaticPointers is not supported in GHCi interactive expressions."]
+              return $ xopt_unset dflags0 LangExt.StaticPointers
+      else return dflags0
+  return dflags1
+
+
 -- %************************************************************************
 -- %*                                                                      *
 --             Setting, getting, and modifying the targets
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index 94c02d5017..77b9581a2e 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -1286,6 +1286,18 @@ upsweep mHscMessage old_hpt stable_mods cleanup sccs = do
                 hsc_env4 <- liftIO $ reTypecheckLoop hsc_env3 mod done'
                 setSession hsc_env4
 
+                        -- Add any necessary entries to the static pointer
+                        -- table. See Note [Grand plan for static forms] in
+                        -- StaticPtrTable.
+                when (hscTarget (hsc_dflags hsc_env4) == HscInterpreted) $
+                    liftIO $ hscAddSptEntries hsc_env4
+                                 [ spt
+                                 | Just linkable <- pure $ hm_linkable mod_info
+                                 , unlinked <- linkableUnlinked linkable
+                                 , BCOs _ spts <- pure unlinked
+                                 , spt <- spts
+                                 ]
+
                 upsweep' old_hpt1 done' mods (mod_index+1) nmods uids_to_check' done_holes'
 
 unitIdsToCheck :: DynFlags -> [UnitId]
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 092f04c1aa..c8aa0ab390 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -79,10 +79,12 @@ module HscMain
     , hscFileFrontEnd, genericHscFrontend, dumpIfaceStats
     , ioMsgMaybe
     , showModuleIndex
+    , hscAddSptEntries
     ) where
 
 import Data.Data hiding (Fixity, TyCon)
 import Id
+import GHCi             ( addSptEntry )
 import GHCi.RemoteTypes ( ForeignHValue )
 import ByteCodeGen      ( byteCodeGen, coreExprToBCOs )
 import Linker
@@ -1308,7 +1310,7 @@ hscGenHardCode hsc_env cgguts mod_summary output_filename = do
 hscInteractive :: HscEnv
                -> CgGuts
                -> ModSummary
-               -> IO (Maybe FilePath, CompiledByteCode)
+               -> IO (Maybe FilePath, CompiledByteCode, [SptEntry])
 hscInteractive hsc_env cgguts mod_summary = do
     let dflags = hsc_dflags hsc_env
     let CgGuts{ -- This is the last use of the ModGuts in a compilation.
@@ -1317,7 +1319,8 @@ hscInteractive hsc_env cgguts mod_summary = do
                cg_binds    = core_binds,
                cg_tycons   = tycons,
                cg_foreign  = foreign_stubs,
-               cg_modBreaks = mod_breaks } = cgguts
+               cg_modBreaks = mod_breaks,
+               cg_spt_entries = spt_entries } = cgguts
 
         location = ms_location mod_summary
         data_tycons = filter isDataTyCon tycons
@@ -1331,10 +1334,10 @@ hscInteractive hsc_env cgguts mod_summary = do
                    corePrepPgm hsc_env this_mod location core_binds data_tycons
     -----------------  Generate byte code ------------------
     comp_bc <- byteCodeGen hsc_env this_mod prepd_binds data_tycons mod_breaks
-    ------------------ Create f-x-dynamic C-side stuff ---
+    ------------------ Create f-x-dynamic C-side stuff -----
     (_istub_h_exists, istub_c_exists)
         <- outputForeignStubs dflags this_mod location foreign_stubs
-    return (istub_c_exists, comp_bc)
+    return (istub_c_exists, comp_bc, spt_entries)
 
 ------------------------------
 
@@ -1572,6 +1575,9 @@ hscDeclsWithLocation hsc_env0 str source linenumber =
     let src_span = srcLocSpan interactiveSrcLoc
     liftIO $ linkDecls hsc_env src_span cbc
 
+    {- Load static pointer table entries -}
+    liftIO $ hscAddSptEntries hsc_env (cg_spt_entries tidy_cg)
+
     let tcs = filterOut isImplicitTyCon (mg_tcs simpl_mg)
         patsyns = mg_patsyns simpl_mg
 
@@ -1593,6 +1599,16 @@ hscDeclsWithLocation hsc_env0 str source linenumber =
                                                 fam_insts defaults fix_env
     return (new_tythings, new_ictxt)
 
+-- | Load the given static-pointer table entries into the interpreter.
+-- See Note [Grand plan for static forms] in StaticPtrTable.
+hscAddSptEntries :: HscEnv -> [SptEntry] -> IO ()
+hscAddSptEntries hsc_env entries = do
+    let add_spt_entry :: SptEntry -> IO ()
+        add_spt_entry (SptEntry i fpr) = do
+            val <- getHValue hsc_env (idName i)
+            pprTrace "add_spt_entry" (ppr fpr <+> ppr i) $
+                addSptEntry hsc_env fpr val
+    mapM_ add_spt_entry entries
 
 {-
   Note [Fixity declarations in GHCi]
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 0fcf58229b..f44a261e76 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -22,7 +22,7 @@ module HscTypes (
         -- * Information about modules
         ModDetails(..), emptyModDetails,
         ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC,
-        ImportedMods, ImportedModsVal(..),
+        ImportedMods, ImportedModsVal(..), SptEntry(..),
 
         ModSummary(..), ms_imps, ms_installed_mod, ms_mod_name, showModMsg, isBootSummary,
         msHsFilePath, msHiFilePath, msObjFilePath,
@@ -1281,8 +1281,12 @@ data CgGuts
         cg_foreign   :: !ForeignStubs,   -- ^ Foreign export stubs
         cg_dep_pkgs  :: ![InstalledUnitId], -- ^ Dependent packages, used to
                                             -- generate #includes for C code gen
-        cg_hpc_info  :: !HpcInfo,        -- ^ Program coverage tick box information
-        cg_modBreaks :: !(Maybe ModBreaks) -- ^ Module breakpoints
+        cg_hpc_info  :: !HpcInfo,           -- ^ Program coverage tick box information
+        cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints
+        cg_spt_entries :: [SptEntry]
+                -- ^ Static pointer table entries for static forms defined in
+                -- the module.
+                -- See Note [Grand plan for static forms] in StaticPtrTable
     }
 
 -----------------------------------
@@ -1303,6 +1307,13 @@ appendStubC :: ForeignStubs -> SDoc -> ForeignStubs
 appendStubC NoStubs            c_code = ForeignStubs empty c_code
 appendStubC (ForeignStubs h c) c_code = ForeignStubs h (c $$ c_code)
 
+-- | An entry to be inserted into a module's static pointer table.
+-- See Note [Grand plan for static forms] in StaticPtrTable.
+data SptEntry = SptEntry Id Fingerprint
+
+instance Outputable SptEntry where
+  ppr (SptEntry id fpr) = ppr id <> colon <+> ppr fpr
+
 {-
 ************************************************************************
 *                                                                      *
@@ -2951,13 +2962,18 @@ data Unlinked
    = DotO FilePath      -- ^ An object file (.o)
    | DotA FilePath      -- ^ Static archive file (.a)
    | DotDLL FilePath    -- ^ Dynamically linked library file (.so, .dll, .dylib)
-   | BCOs CompiledByteCode    -- ^ A byte-code object, lives only in memory
+   | BCOs CompiledByteCode
+          [SptEntry]    -- ^ A byte-code object, lives only in memory. Also
+                        -- carries some static pointer table entries which
+                        -- should be loaded along with the BCOs.
+                        -- See Note [Grant plan for static forms] in
+                        -- StaticPtrTable.
 
 instance Outputable Unlinked where
    ppr (DotO path)   = text "DotO" <+> text path
    ppr (DotA path)   = text "DotA" <+> text path
    ppr (DotDLL path) = text "DotDLL" <+> text path
-   ppr (BCOs bcos) = text "BCOs" <+> ppr bcos
+   ppr (BCOs bcos spt) = text "BCOs" <+> ppr bcos <+> ppr spt
 
 -- | Is this an actual file on disk we can link in somehow?
 isObject :: Unlinked -> Bool
@@ -2979,8 +2995,8 @@ nameOfObject other       = pprPanic "nameOfObject" (ppr other)
 
 -- | Retrieve the compiled byte-code if possible. Panic if it is a file-based linkable
 byteCodeOfObject :: Unlinked -> CompiledByteCode
-byteCodeOfObject (BCOs bc) = bc
-byteCodeOfObject other     = pprPanic "byteCodeOfObject" (ppr other)
+byteCodeOfObject (BCOs bc _) = bc
+byteCodeOfObject other       = pprPanic "byteCodeOfObject" (ppr other)
 
 
 -------------------------------------------
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 93abb07ec0..1fa269825d 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -116,7 +116,7 @@ getHistorySpan hsc_env History{..} =
 getModBreaks :: HomeModInfo -> ModBreaks
 getModBreaks hmi
   | Just linkable <- hm_linkable hmi,
-    [BCOs cbc] <- linkableUnlinked linkable
+    [BCOs cbc _] <- linkableUnlinked linkable
   = fromMaybe emptyModBreaks (bc_breaks cbc)
   | otherwise
   = emptyModBreaks -- probably object code
diff --git a/compiler/main/StaticPtrTable.hs b/compiler/main/StaticPtrTable.hs
index 7a836e6068..f61714db61 100644
--- a/compiler/main/StaticPtrTable.hs
+++ b/compiler/main/StaticPtrTable.hs
@@ -45,8 +45,11 @@
 -- > }
 --
 
-{-# LANGUAGE ViewPatterns #-}
-module StaticPtrTable (sptCreateStaticBinds) where
+{-# LANGUAGE ViewPatterns, TupleSections #-}
+module StaticPtrTable
+    ( sptCreateStaticBinds
+    , sptModuleInitCode
+    ) where
 
 {- Note [Grand plan for static forms]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -114,10 +117,15 @@ Here is a running example:
 
   where a distinct key is generated for each binding.
 
-  We produce also a C function which inserts all these bindings in the static
-  pointer table (see the call to StaticPtrTable.sptCreateStaticBinds in
-  TidyPgm). As the Ids of floated static pointers are exported, they can be
-  linked with the C function.
+* 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 GhcMake.upsweep').
 -}
 
 import CLabel
@@ -157,15 +165,15 @@ import qualified GHC.LanguageExtensions as LangExt
 -- It also yields the C stub that inserts these bindings into the static
 -- pointer table.
 sptCreateStaticBinds :: HscEnv -> Module -> CoreProgram
-                     -> IO (SDoc, CoreProgram)
+                     -> IO ([SptEntry], CoreProgram)
 sptCreateStaticBinds hsc_env this_mod binds
     | not (xopt LangExt.StaticPointers dflags) =
-      return (Outputable.empty, binds)
+      return ([], binds)
     | otherwise = do
       -- Make sure the required interface files are loaded.
       _ <- lookupGlobal hsc_env unpackCStringName
       (fps, binds') <- evalStateT (go [] [] binds) 0
-      return (sptModuleInitCode this_mod fps, binds')
+      return (fps, binds')
   where
     go fps bs xs = case xs of
       []        -> return (reverse fps, reverse bs)
@@ -179,7 +187,7 @@ sptCreateStaticBinds hsc_env this_mod binds
     --
     -- The 'Int' state is used to produce a different key for each binding.
     replaceStaticBind :: CoreBind
-                      -> StateT Int IO ([(Id, Fingerprint)], CoreBind)
+                      -> StateT Int IO ([SptEntry], CoreBind)
     replaceStaticBind (NonRec b e) = do (mfp, (b', e')) <- replaceStatic b e
                                         return (maybeToList mfp, NonRec b' e')
     replaceStaticBind (Rec rbs) = do
@@ -187,13 +195,13 @@ sptCreateStaticBinds hsc_env this_mod binds
       return (catMaybes mfps, Rec rbs')
 
     replaceStatic :: Id -> CoreExpr
-                  -> StateT Int IO (Maybe (Id, Fingerprint), (Id, CoreExpr))
+                  -> StateT Int IO (Maybe SptEntry, (Id, CoreExpr))
     replaceStatic b e@(collectTyBinders -> (tvs, e0)) =
       case collectMakeStaticArgs e0 of
         Nothing      -> return (Nothing, (b, e))
         Just (_, t, info, arg) -> do
           (fp, e') <- mkStaticBind t info arg
-          return (Just (b, fp), (b, foldr Lam e' tvs))
+          return (Just (SptEntry b fp), (b, foldr Lam e' tvs))
 
     mkStaticBind :: Type -> CoreExpr -> CoreExpr
                  -> StateT Int IO (Fingerprint, CoreExpr)
@@ -249,7 +257,7 @@ sptCreateStaticBinds hsc_env this_mod binds
 --
 -- @fps@ is a list associating each binding corresponding to a static entry with
 -- its fingerprint.
-sptModuleInitCode :: Module -> [(Id, Fingerprint)] -> SDoc
+sptModuleInitCode :: Module -> [SptEntry] -> SDoc
 sptModuleInitCode _ [] = Outputable.empty
 sptModuleInitCode this_mod entries = vcat
     [ text "static void hs_spt_init_" <> ppr this_mod
@@ -267,7 +275,7 @@ sptModuleInitCode this_mod entries = vcat
                 ]
              )
         <> semi
-        |  (i, (n, fp)) <- zip [0..] entries
+        |  (i, SptEntry n fp) <- zip [0..] entries
         ]
     , text "static void hs_spt_fini_" <> ppr this_mod
            <> text "(void) __attribute__((destructor));"
@@ -276,7 +284,7 @@ sptModuleInitCode this_mod entries = vcat
         [  text "StgWord64 k" <> int i <> text "[2] = "
            <> pprFingerprint fp <> semi
         $$ text "hs_spt_remove" <> parens (char 'k' <> int i) <> semi
-        | (i, (_, fp)) <- zip [0..] entries
+        | (i, (SptEntry _ fp)) <- zip [0..] entries
         ]
     ]
   where
diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs
index c546e5c257..0fc153ad4c 100644
--- a/compiler/main/TidyPgm.hs
+++ b/compiler/main/TidyPgm.hs
@@ -377,8 +377,18 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
               ; tidy_type_env = tidyTypeEnv omit_prags type_env2
               }
           -- See Note [Grand plan for static forms] in StaticPtrTable.
-        ; (spt_init_code, tidy_binds') <-
+        ; (spt_entries, tidy_binds') <-
              sptCreateStaticBinds hsc_env mod tidy_binds
+        ; let { spt_init_code = sptModuleInitCode mod spt_entries
+              ; add_spt_init_code =
+                  case hscTarget dflags of
+                    -- If we are compiling for the interpreter we will insert
+                    -- any necessary SPT entries dynamically
+                    HscInterpreted -> id
+                    -- otherwise add a C stub to do so
+                    _              -> (`appendStubC` spt_init_code)
+              }
+
         ; let { -- See Note [Injecting implicit bindings]
                 all_tidy_binds = implicit_binds ++ tidy_binds'
 
@@ -415,11 +425,11 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
         ; return (CgGuts { cg_module   = mod,
                            cg_tycons   = alg_tycons,
                            cg_binds    = all_tidy_binds,
-                           cg_foreign  = foreign_stubs `appendStubC`
-                                         spt_init_code,
+                           cg_foreign  = add_spt_init_code foreign_stubs,
                            cg_dep_pkgs = map fst $ dep_pkgs deps,
                            cg_hpc_info = hpc_info,
-                           cg_modBreaks = modBreaks },
+                           cg_modBreaks = modBreaks,
+                           cg_spt_entries = spt_entries },
 
                    ModDetails { md_types     = tidy_type_env,
                                 md_rules     = tidy_rules,
diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs
index 17c9042f22..769dff0fb6 100644
--- a/compiler/rename/RnExpr.hs
+++ b/compiler/rename/RnExpr.hs
@@ -360,15 +360,6 @@ wired-in. See the Notes about the NameSorts in Name.hs.
 -}
 
 rnExpr e@(HsStatic _ expr) = do
-    target <- fmap hscTarget getDynFlags
-    case target of
-      -- SPT entries are expected to exist in object code so far, and this is
-      -- not the case in interpreted mode. See bug #9878.
-      HscInterpreted -> addErr $ sep
-        [ text "The static form is not supported in interpreted mode."
-        , text "Please use -fobject-code."
-        ]
-      _ -> return ()
     (expr',fvExpr) <- rnLExpr expr
     stage <- getStage
     case stage of
diff --git a/docs/users_guide/8.2.1-notes.rst b/docs/users_guide/8.2.1-notes.rst
index f81c3995e0..d29914a100 100644
--- a/docs/users_guide/8.2.1-notes.rst
+++ b/docs/users_guide/8.2.1-notes.rst
@@ -145,6 +145,9 @@ GHCi
 
 - Added :ghc-flag:`-flocal-ghci-history` which uses current directory for `.ghci-history`.
 
+- Added support for :ghc-flag:`-XStaticPointers` in interpreted modules. Note, however,
+  that ``static`` expressions are still not allowed in expressions evaluated in the REPL.
+
 Template Haskell
 ~~~~~~~~~~~~~~~~
 
diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst
index 0bbf6588cc..c2d8437303 100644
--- a/docs/users_guide/glasgow_exts.rst
+++ b/docs/users_guide/glasgow_exts.rst
@@ -11984,6 +11984,13 @@ While the following definitions are rejected: ::
     ref8 (y :: a) = let x = undefined :: a
                      in static x      -- x has a non-closed type
 
+.. note::
+
+    While modules loaded in GHCi with the :ghci-cmd:`:load` command may use
+    :ghc-flag:`-XStaticPointers` and ``static`` expressions, statements
+    entered on the REPL may not. This is a limitation of GHCi; see
+    :ghc-ticket:`12356` for details.
+
 .. _typechecking-static-pointers:
 
 Static semantics of static pointers
diff --git a/includes/rts/StaticPtrTable.h b/includes/rts/StaticPtrTable.h
index 9c03d05ed3..e536f4b496 100644
--- a/includes/rts/StaticPtrTable.h
+++ b/includes/rts/StaticPtrTable.h
@@ -28,6 +28,14 @@
  * */
 void hs_spt_insert (StgWord64 key[2],void* spe_closure);
 
+/** Inserts an entry for a StgTablePtr in the Static Pointer Table.
+ *
+ * This function is called from the GHCi interpreter to insert
+ * SPT entries for bytecode objects.
+ *
+ * */
+void hs_spt_insert_stableptr(StgWord64 key[2], StgStablePtr *entry);
+
 /** Removes an entry from the Static Pointer Table.
  *
  * This function is called from the code generated by
diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs
index fe4e95eb9e..c336349daf 100644
--- a/libraries/ghci/GHCi/Message.hs
+++ b/libraries/ghci/GHCi/Message.hs
@@ -30,6 +30,7 @@ import GHCi.TH.Binary ()
 import GHCi.BreakArray
 
 import GHC.LanguageExtensions
+import GHC.Fingerprint
 import Control.Concurrent
 import Control.Exception
 import Data.Binary
@@ -85,6 +86,9 @@ data Message a where
   -- | Release 'HValueRef's
   FreeHValueRefs :: [HValueRef] -> Message ()
 
+  -- | Add entries to the Static Pointer Table
+  AddSptEntry :: Fingerprint -> HValueRef -> Message ()
+
   -- | Malloc some data and return a 'RemotePtr' to it
   MallocData :: ByteString -> Message (RemotePtr ())
   MallocStrings :: [ByteString] -> Message [RemotePtr ()]
@@ -446,6 +450,7 @@ getMessage = do
       30 -> Msg <$> (GetBreakpointVar <$> get <*> get)
       31 -> Msg <$> return StartTH
       32 -> Msg <$> (RunModFinalizers <$> get <*> get)
+      33 -> Msg <$> (AddSptEntry <$> get <*> get)
       _  -> Msg <$> (RunTH <$> get <*> get <*> get <*> get)
 
 putMessage :: Message a -> Put
@@ -483,7 +488,8 @@ putMessage m = case m of
   GetBreakpointVar a b        -> putWord8 30 >> put a >> put b
   StartTH                     -> putWord8 31
   RunModFinalizers a b        -> putWord8 32 >> put a >> put b
-  RunTH st q loc ty           -> putWord8 33 >> put st >> put q >> put loc >> put ty
+  AddSptEntry a b             -> putWord8 33 >> put a >> put b
+  RunTH st q loc ty           -> putWord8 34 >> put st >> put q >> put loc >> put ty
 
 -- -----------------------------------------------------------------------------
 -- Reading/writing messages
diff --git a/libraries/ghci/GHCi/Run.hs b/libraries/ghci/GHCi/Run.hs
index 858b247f65..eecafa1f75 100644
--- a/libraries/ghci/GHCi/Run.hs
+++ b/libraries/ghci/GHCi/Run.hs
@@ -20,6 +20,7 @@ import GHCi.ObjLink
 import GHCi.RemoteTypes
 import GHCi.TH
 import GHCi.BreakArray
+import GHCi.StaticPtrTable
 
 import Control.Concurrent
 import Control.DeepSeq
@@ -56,6 +57,7 @@ run m = case m of
   FindSystemLibrary str -> findSystemLibrary str
   CreateBCOs bcos -> createBCOs (concatMap (runGet get) bcos)
   FreeHValueRefs rs -> mapM_ freeRemoteRef rs
+  AddSptEntry fpr r -> localRef r >>= sptAddEntry fpr
   EvalStmt opts r -> evalStmt opts r
   ResumeStmt opts r -> resumeStmt opts r
   AbandonStmt r -> abandonStmt r
diff --git a/libraries/ghci/GHCi/StaticPtrTable.hs b/libraries/ghci/GHCi/StaticPtrTable.hs
new file mode 100644
index 0000000000..d23e810f8a
--- /dev/null
+++ b/libraries/ghci/GHCi/StaticPtrTable.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module GHCi.StaticPtrTable ( sptAddEntry ) where
+
+import Data.Word
+import Foreign
+import GHC.Fingerprint
+import GHCi.RemoteTypes
+
+-- | Used by GHCi to add an SPT entry for a set of interactive bindings.
+sptAddEntry :: Fingerprint -> HValue -> IO ()
+sptAddEntry (Fingerprint a b) (HValue x) = do
+    -- We own the memory holding the key (fingerprint) which gets inserted into
+    -- the static pointer table and can't free it until the SPT entry is removed
+    -- (which is currently never).
+    fpr_ptr <- newArray [a,b]
+    sptr <- newStablePtr x
+    ent_ptr <- malloc
+    poke ent_ptr (castStablePtrToPtr sptr)
+    spt_insert_stableptr fpr_ptr ent_ptr
+
+foreign import ccall "hs_spt_insert_stableptr"
+    spt_insert_stableptr :: Ptr Word64 -> Ptr (Ptr ()) -> IO ()
diff --git a/libraries/ghci/ghci.cabal.in b/libraries/ghci/ghci.cabal.in
index 87b2c4e2fd..631eed7190 100644
--- a/libraries/ghci/ghci.cabal.in
+++ b/libraries/ghci/ghci.cabal.in
@@ -62,6 +62,7 @@ library
         GHCi.RemoteTypes
         GHCi.FFI
         GHCi.InfoTable
+        GHCi.StaticPtrTable
         GHCi.TH.Binary
         SizedSeq
 
diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c
index be61388501..b5e4f8e8bf 100644
--- a/rts/RtsSymbols.c
+++ b/rts/RtsSymbols.c
@@ -904,6 +904,7 @@
       SymI_HasProto(atomic_dec)                                         \
       SymI_HasProto(hs_spt_lookup)                                      \
       SymI_HasProto(hs_spt_insert)                                      \
+      SymI_HasProto(hs_spt_insert_stableptr)                            \
       SymI_HasProto(hs_spt_remove)                                      \
       SymI_HasProto(hs_spt_keys)                                        \
       SymI_HasProto(hs_spt_key_count)                                   \
diff --git a/rts/StaticPtrTable.c b/rts/StaticPtrTable.c
index 57ade5bafb..b793b9c56c 100644
--- a/rts/StaticPtrTable.c
+++ b/rts/StaticPtrTable.c
@@ -31,7 +31,7 @@ static int compareFingerprint(StgWord64 ptra[2], StgWord64 ptrb[2]) {
   return ptra[0] == ptrb[0] && ptra[1] == ptrb[1];
 }
 
-void hs_spt_insert(StgWord64 key[2],void *spe_closure) {
+void hs_spt_insert_stableptr(StgWord64 key[2], StgStablePtr *entry) {
   // hs_spt_insert is called from constructor functions, so
   // the SPT needs to be initialized here.
   if (spt == NULL) {
@@ -43,6 +43,12 @@ void hs_spt_insert(StgWord64 key[2],void *spe_closure) {
 #endif
   }
 
+  ACQUIRE_LOCK(&spt_lock);
+  insertHashTable(spt, (StgWord)key, entry);
+  RELEASE_LOCK(&spt_lock);
+}
+
+void hs_spt_insert(StgWord64 key[2], void *spe_closure) {
   // Cannot remove this indirection yet because getStablePtr()
   // might return NULL, in which case hs_spt_lookup() returns NULL
   // instead of the actual closure pointer.
@@ -50,9 +56,7 @@ void hs_spt_insert(StgWord64 key[2],void *spe_closure) {
                                        , "hs_spt_insert: entry"
                                        );
   *entry = getStablePtr(spe_closure);
-  ACQUIRE_LOCK(&spt_lock);
-  insertHashTable(spt, (StgWord)key, entry);
-  RELEASE_LOCK(&spt_lock);
+  hs_spt_insert_stableptr(key, entry);
 }
 
 static void freeSptEntry(void* entry) {
diff --git a/testsuite/tests/ghci/scripts/StaticPtr.hs b/testsuite/tests/ghci/scripts/StaticPtr.hs
new file mode 100644
index 0000000000..41bf6231cc
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/StaticPtr.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE StaticPointers #-}
+
+module StaticPtr where
+
+import GHC.StaticPtr
+
+topLevelStatic :: StaticPtr String
+topLevelStatic = static "this is a top-level"
+
+nestedStatic :: (StaticPtr String, Int)
+nestedStatic = (s, 42)
+  where
+    s = static "nested static"
+    {-# NOINLINE s #-}
+
+s1 :: StaticPtr Int
+s1 = static 3
+
+s2 :: StaticPtr String
+s2 = static "hello world"
diff --git a/testsuite/tests/ghci/scripts/StaticPtr.script b/testsuite/tests/ghci/scripts/StaticPtr.script
new file mode 100644
index 0000000000..925a21ef39
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/StaticPtr.script
@@ -0,0 +1,27 @@
+-- This should throw a warning
+:set -XStaticPointers
+
+:set -XScopedTypeVariables
+:load StaticPtr.hs
+import GHC.StaticPtr
+import Prelude
+
+:{
+let checkKey :: forall a. (Show a, Eq a) => StaticPtr a -> IO ()
+    checkKey x = do
+      allKeys <- staticPtrKeys
+      Just x' <- unsafeLookupStaticPtr (staticKey x) :: IO (Maybe (StaticPtr a))
+      putStrLn $
+        show (deRefStaticPtr x)
+        ++ "    " ++
+        (if deRefStaticPtr x == deRefStaticPtr x'
+            then "good"
+            else "bad")
+:}
+
+checkKey s1
+checkKey s2
+
+-- :m + StaticPtr
+--checkKey topLevelStatic
+--checkKey (fst nestedStatic)
diff --git a/testsuite/tests/ghci/scripts/StaticPtr.stderr b/testsuite/tests/ghci/scripts/StaticPtr.stderr
new file mode 100644
index 0000000000..b45f64e64d
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/StaticPtr.stderr
@@ -0,0 +1,3 @@
+
+<interactive>: warning:
+    StaticPointers is not supported in GHCi interactive expressions.
diff --git a/testsuite/tests/ghci/scripts/StaticPtr.stdout b/testsuite/tests/ghci/scripts/StaticPtr.stdout
new file mode 100644
index 0000000000..992ca432e2
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/StaticPtr.stdout
@@ -0,0 +1,2 @@
+3    good
+"hello world"    good
diff --git a/testsuite/tests/ghci/scripts/T9878.stderr b/testsuite/tests/ghci/scripts/T9878.stderr
index 98a8edfe25..e69de29bb2 100644
--- a/testsuite/tests/ghci/scripts/T9878.stderr
+++ b/testsuite/tests/ghci/scripts/T9878.stderr
@@ -1,4 +0,0 @@
-
-T9878.hs:6:21:
-    The static form is not supported in interpreted mode.
-    Please use -fobject-code.
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index fd82c6fc8b..5621addb26 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -242,3 +242,4 @@ test('T12024', normal, ghci_script, ['T12024.script'])
 test('T12447', expect_broken(12447), ghci_script, ['T12447.script'])
 test('T10249', normal, ghci_script, ['T10249.script'])
 test('T12550', normal, ghci_script, ['T12550.script'])
+test('StaticPtr', normal, ghci_script, ['StaticPtr.script'])