Implement -XStaticValues

Summary:
As proposed in [1], this extension introduces a new syntactic form
`static e`, where `e :: a` can be any closed expression. The static form
produces a value of type `StaticPtr a`, which works as a reference that
programs can "dereference" to get the value of `e` back. References are
like `Ptr`s, except that they are stable across invocations of a
program.

The relevant wiki pages are [2, 3], which describe the motivation/ideas
and implementation plan respectively.

[1] Jeff Epstein, Andrew P. Black, and Simon Peyton-Jones. Towards
Haskell in the cloud. SIGPLAN Not., 46(12):118–129, September 2011. ISSN
0362-1340.
[2] https://ghc.haskell.org/trac/ghc/wiki/StaticPointers
[3] https://ghc.haskell.org/trac/ghc/wiki/StaticPointers/ImplementationPlan

Authored-by: Facundo Domínguez <facundo.dominguez@tweag.io>
Authored-by: Mathieu Boespflug <m@tweag.io>
Authored-by: Alexander Vershilov <alexander.vershilov@tweag.io>

Test Plan: `./validate`

Reviewers: hvr, simonmar, simonpj, austin

Reviewed By: simonpj, austin

Subscribers: qnikst, bgamari, mboes, carter, thomie, goldfire

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

GHC Trac Issues: #7015

3 files changed, 44 insertions, 0 deletions

diff --git a/testsuite/tests/codeGen/should_run/CgStaticPointers.hs b/testsuite/tests/codeGen/should_run/CgStaticPointers.hs
new file mode 100644
index 0000000000..5576f431e8
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/CgStaticPointers.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE StaticPointers     #-}
+
+-- | A test to use symbols produced by the static form.
+module Main(main) where
+
+import Data.Typeable
+import GHC.StaticPtr
+
+main :: IO ()
+main = do
+  print $ lookupKey (static (id . id)) (1 :: Int)
+  print $ lookupKey (static method :: StaticPtr (Char -> Int)) 'a'
+  print $ deRefStaticPtr (static g)
+  print $ deRefStaticPtr p0 'a'
+  print $ deRefStaticPtr (static t_field) $ T 'b'
+
+lookupKey :: StaticPtr a -> a
+lookupKey p = case unsafeLookupStaticPtr (staticKey p) of
+  Just p -> deRefStaticPtr p
+  Nothing -> error $ "couldn't find " ++ show (staticPtrInfo p)
+
+g :: String
+g = "found"
+
+p0 :: Typeable a => StaticPtr (a -> a)
+p0 = static (\x -> x)
+
+data T a = T { t_field :: a }
+  deriving Typeable
+
+class C1 a where
+  method :: a -> Int
+
+instance C1 Char where
+  method = const 0
diff --git a/testsuite/tests/codeGen/should_run/CgStaticPointers.stdout b/testsuite/tests/codeGen/should_run/CgStaticPointers.stdout
new file mode 100644
index 0000000000..7b31e7fa2c
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/CgStaticPointers.stdout
@@ -0,0 +1,5 @@
+1
+0
+"found"
+'a'
+'b'
diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T
index f157287c79..89f62781eb 100644
--- a/testsuite/tests/codeGen/should_run/all.T
+++ b/testsuite/tests/codeGen/should_run/all.T
@@ -114,6 +114,9 @@ test('T8103', only_ways(['normal']), compile_and_run, [''])
 test('T7953', reqlib('random'), compile_and_run, [''])
 test('T8256', reqlib('vector'), compile_and_run, [''])
 test('T6084',normal, compile_and_run, ['-O2'])
+test('CgStaticPointers',
+     [ when(compiler_lt('ghc', '7.9'), skip) ],
+     compile_and_run, [''])
 test('StaticArraySize', normal, compile_and_run, ['-O2'])
 test('StaticByteArraySize', normal, compile_and_run, ['-O2'])
 test('CopySmallArray', normal, compile_and_run, [''])