StaticPointers: Allow closed vars in the static form.

Summary:
With this patch closed variables are allowed regardless of whether
they are bound at the top level or not.

The FloatOut pass is always performed. When optimizations are
disabled, only expressions that go to the top level are floated.
Thus, the applications of the StaticPtr data constructor are always
floated.

The CoreTidy pass makes sure the floated applications appear in the
symbol table of object files. It also collects the floated bindings
and inserts them in the static pointer table.

The renamer does not check anymore if free variables appearing in the
static form are top-level. Instead, the typechecker looks at the
tct_closed flag to decide if the free variables are closed.

The linter checks that applications of StaticPtr only occur at the
top of top-level bindings after the FloatOut pass.

The field spInfoName of StaticPtrInfo has been removed. It used to
contain the name of the top-level binding that contains the StaticPtr
application. However, this information is no longer available when the
StaticPtr is constructed, as the binding name is determined now by the
FloatOut pass.

Test Plan: ./validate

Reviewers: goldfire, simonpj, austin, hvr, bgamari

Reviewed By: simonpj

Subscribers: thomie, mpickering, mboes

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

GHC Trac Issues: #11656

2 files changed, 20 insertions, 9 deletions

diff --git a/libraries/base/GHC/StaticPtr.hs b/libraries/base/GHC/StaticPtr.hs
index 3d5807a32f..1f145201ee 100644
--- a/libraries/base/GHC/StaticPtr.hs
+++ b/libraries/base/GHC/StaticPtr.hs
@@ -1,6 +1,7 @@
+{-# LANGUAGE CPP                       #-}
+{-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE MagicHash                 #-}
 {-# LANGUAGE UnboxedTuples             #-}
-{-# LANGUAGE ExistentialQuantification #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.StaticPtr
@@ -47,14 +48,24 @@ import Foreign.Ptr         (castPtr)
 import GHC.Exts            (addrToAny#)
 import GHC.Ptr             (Ptr(..), nullPtr)
 import GHC.Fingerprint     (Fingerprint(..))
+import GHC.Prim
+import GHC.Word            (Word64(..))
 
 
--- | A reference to a value of type 'a'.
-data StaticPtr a = StaticPtr StaticKey StaticPtrInfo a
+#include "MachDeps.h"
 
+-- | A reference to a value of type 'a'.
+#if WORD_SIZE_IN_BITS < 64
+data StaticPtr a = StaticPtr Word64# Word64# -- The flattened Fingerprint is
+                                             -- convenient in the compiler.
+                             StaticPtrInfo a
+#else
+data StaticPtr a = StaticPtr Word# Word#
+                             StaticPtrInfo a
+#endif
 -- | Dereferences a static pointer.
 deRefStaticPtr :: StaticPtr a -> a
-deRefStaticPtr (StaticPtr _ _ v) = v
+deRefStaticPtr (StaticPtr _ _ _ v) = v
 
 -- | A key for `StaticPtrs` that can be serialized and used with
 -- 'unsafeLookupStaticPtr'.
@@ -62,7 +73,7 @@ type StaticKey = Fingerprint
 
 -- | The 'StaticKey' that can be used to look up the given 'StaticPtr'.
 staticKey :: StaticPtr a -> StaticKey
-staticKey (StaticPtr k _ _) = k
+staticKey (StaticPtr w0 w1 _ _) = Fingerprint (W64# w0) (W64# w1)
 
 -- | Looks up a 'StaticPtr' by its 'StaticKey'.
 --
@@ -94,9 +105,6 @@ data StaticPtrInfo = StaticPtrInfo
       spInfoUnitId  :: String
       -- | Name of the module where the static pointer is defined
     , spInfoModuleName :: String
-      -- | An internal name that is distinct for every static pointer defined in
-      -- a given module.
-    , spInfoName       :: String
       -- | Source location of the definition of the static pointer as a
       -- @(Line, Column)@ pair.
     , spInfoSrcLoc     :: (Int, Int)
@@ -105,7 +113,7 @@ data StaticPtrInfo = StaticPtrInfo
 
 -- | 'StaticPtrInfo' of the given 'StaticPtr'.
 staticPtrInfo :: StaticPtr a -> StaticPtrInfo
-staticPtrInfo (StaticPtr _ n _) = n
+staticPtrInfo (StaticPtr _ _ n _) = n
 
 -- | A list of all known keys.
 staticPtrKeys :: IO [StaticKey]
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index dd386ed477..4b40db798d 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -157,6 +157,9 @@
 
   * `CallStack` now has an `IsList` instance
 
+  * The field `spInfoName` of `GHC.StaticPtr.StaticPtrInfo` has been removed.
+    The value is no longer available when constructing the `StaticPtr`.
+
 ### Generalizations
 
   * Generalize `Debug.Trace.{traceM, traceShowM}` from `Monad` to `Applicative`