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

7 files changed, 43 insertions, 0 deletions

diff --git a/testsuite/tests/rename/should_fail/RnStaticPointersFail01.hs b/testsuite/tests/rename/should_fail/RnStaticPointersFail01.hs
new file mode 100644
index 0000000000..18631a2dc5
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/RnStaticPointersFail01.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE StaticPointers #-}
+
+module RnStaticPointersFail01 where
+
+f x = static x
diff --git a/testsuite/tests/rename/should_fail/RnStaticPointersFail01.stderr b/testsuite/tests/rename/should_fail/RnStaticPointersFail01.stderr
new file mode 100644
index 0000000000..b7ff89c886
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/RnStaticPointersFail01.stderr
@@ -0,0 +1,6 @@
+
+RnStaticPointersFail01.hs:5:7:
+    Only identifiers of top-level bindings can appear in the body of the static form:
+      static x
+    but the following identifiers were found instead:
+      x
diff --git a/testsuite/tests/rename/should_fail/RnStaticPointersFail02.hs b/testsuite/tests/rename/should_fail/RnStaticPointersFail02.hs
new file mode 100644
index 0000000000..599cf53076
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/RnStaticPointersFail02.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE StaticPointers #-}
+
+module RnStaticPointersFail02 where
+
+f = static T
+
+data T = TDataCons
diff --git a/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr b/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr
new file mode 100644
index 0000000000..6524702276
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr
@@ -0,0 +1,8 @@
+
+RnStaticPointersFail02.hs:5:5:
+    Only identifiers of top-level bindings can appear in the body of the static form:
+      static T
+    but the following identifiers were found instead:
+      T
+
+RnStaticPointersFail02.hs:5:12: Not in scope: data constructor ‘T’
diff --git a/testsuite/tests/rename/should_fail/RnStaticPointersFail03.hs b/testsuite/tests/rename/should_fail/RnStaticPointersFail03.hs
new file mode 100644
index 0000000000..1a9baa3fd6
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/RnStaticPointersFail03.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE StaticPointers #-}
+
+module RnStaticPointersFail03 where
+
+f x = static (x . id)
diff --git a/testsuite/tests/rename/should_fail/RnStaticPointersFail03.stderr b/testsuite/tests/rename/should_fail/RnStaticPointersFail03.stderr
new file mode 100644
index 0000000000..d5a7270853
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/RnStaticPointersFail03.stderr
@@ -0,0 +1,6 @@
+
+RnStaticPointersFail03.hs:5:7:
+    Only identifiers of top-level bindings can appear in the body of the static form:
+      static (x . id)
+    but the following identifiers were found instead:
+      x
diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T
index d81b743afc..2798fe96ec 100644
--- a/testsuite/tests/rename/should_fail/all.T
+++ b/testsuite/tests/rename/should_fail/all.T
@@ -112,6 +112,12 @@ test('T7937', normal, compile_fail, [''])
 test('T7943', normal, compile_fail, [''])
 test('T8448', normal, compile_fail, [''])
 test('T8149', normal, compile, [''])
+test('RnStaticPointersFail01',
+     when(compiler_lt('ghc', '7.9'), skip), compile_fail, [''])
+test('RnStaticPointersFail02',
+     when(compiler_lt('ghc', '7.9'), skip), compile_fail, [''])
+test('RnStaticPointersFail03',
+     when(compiler_lt('ghc', '7.9'), skip), compile_fail, [''])
 test('T9006',
      extra_clean(['T9006a.hi', 'T9006a.o']),
      multimod_compile_fail, ['T9006', '-v0'])