Add support for StaticPointers in GHCiwip/ghci-staticptrs

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.

4 files changed, 47 insertions, 0 deletions

diff --git a/testsuite/tests/ghci/scripts/StaticPtr.hs b/testsuite/tests/ghci/scripts/StaticPtr.hs
new file mode 100644
index 0000000000..95b72b305f
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/StaticPtr.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE StaticPointers #-}
+
+module StaticPtr2 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..6070c15943
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/StaticPtr.script
@@ -0,0 +1,23 @@
+:set -XStaticPointers
+:load StaticPtr.hs
+import GHC.StaticPtr
+import Prelude
+
+:{
+let checkKey :: Show a => StaticPtr a -> IO ()
+    checkKey x = do
+      allKeys <- staticPtrKeys
+      putStrLn $
+        show (deRefStaticPtr x)
+        ++ "    " ++
+        (if staticKey x `elem` allKeys
+            then "good"
+            else "bad")
+:}
+
+checkKey s1
+checkKey s2
+
+-- :m + StaticPtr
+--checkKey topLevelStatic
+--checkKey (fst nestedStatic)
diff --git a/testsuite/tests/ghci/scripts/StaticPtr.stdout b/testsuite/tests/ghci/scripts/StaticPtr.stdout
new file mode 100644
index 0000000000..427dc0f15a
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/StaticPtr.stdout
@@ -0,0 +1,3 @@
+3    good
+"hello world"    good
+42    good
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index d448a12d9f..c0e6e153f6 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -270,3 +270,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', [extra_files(['StaticPtr.hs'])], ghci_script, ['StaticPtr.script'])