Overload the static form to reduce verbosity.

Static pointers are rarely used naked: most often they are defined at
the base of a Closure, as defined in e.g. the distributed-closure and
distributed-static packages. So a typical usage pattern is:

    distributeMap (closure (static (\x -> x * 2)))

which is more verbose than it needs to be. Ideally we'd just have to
write

    distributeMap (static (\x -> x * 2))

and let the static pointer be lifted to a Closure implicitly. i.e.
what we want is to overload static literals, just like we already
overload list literals and string literals.

This is achieved by introducing the IsStatic type class and changing
the typing rule for static forms slightly:

    static (e :: t) :: IsStatic p => p t

Test Plan: ./validate

Reviewers: austin, hvr, bgamari

Reviewed By: bgamari

Subscribers: simonpj, mboes, thomie

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

GHC Trac Issues: #11585

compiler/prelude/PrelNames.hs

@@ -371,6 +371,7 @@ basicKnownKeyNames
         -- StaticPtr
         , staticPtrTyConName
         , staticPtrDataConName, staticPtrInfoDataConName
+        , fromStaticPtrName
 
         -- Fingerprint
         , fingerprintDataConName
@@ -1382,6 +1383,10 @@ staticPtrDataConName :: Name
 staticPtrDataConName =
     dcQual gHC_STATICPTR (fsLit "StaticPtr") staticPtrDataConKey
 
+fromStaticPtrName :: Name
+fromStaticPtrName =
+    varQual gHC_STATICPTR (fsLit "fromStaticPtr") fromStaticPtrClassOpKey
+
 fingerprintDataConName :: Name
 fingerprintDataConName =
     dcQual gHC_FINGERPRINT_TYPE (fsLit "Fingerprint") fingerprintDataConKey
@@ -2184,6 +2189,9 @@ emptyCallStackKey, pushCallStackKey :: Unique
 emptyCallStackKey = mkPreludeMiscIdUnique 517
 pushCallStackKey  = mkPreludeMiscIdUnique 518
 
+fromStaticPtrClassOpKey :: Unique
+fromStaticPtrClassOpKey = mkPreludeMiscIdUnique 519
+
 {-
 ************************************************************************
 *                                                                      *

compiler/typecheck/TcExpr.hs

@@ -569,10 +569,10 @@ tcExpr (HsProc pat cmd) res_ty
   = do  { (pat', cmd', coi) <- tcProc pat cmd res_ty
         ; return $ mkHsWrapCo coi (HsProc pat' cmd') }
 
+-- Typechecks the static form and wraps it with a call to 'fromStaticPtr'.
 tcExpr (HsStatic expr) res_ty
-  = do  { staticPtrTyCon  <- tcLookupTyCon staticPtrTyConName
-        ; res_ty          <- expTypeToType res_ty
-        ; (co, [expr_ty]) <- matchExpectedTyConApp staticPtrTyCon res_ty
+  = do  { res_ty          <- expTypeToType res_ty
+        ; (co, (p_ty, expr_ty)) <- matchExpectedAppTy res_ty
         ; (expr', lie)    <- captureConstraints $
             addErrCtxt (hang (text "In the body of a static form:")
                              2 (ppr expr)
@@ -586,10 +586,16 @@ tcExpr (HsStatic expr) res_ty
         ; _ <- emitWantedEvVar StaticOrigin $
                   mkTyConApp (classTyCon typeableClass)
                              [liftedTypeKind, expr_ty]
-        -- Insert the static form in a global list for later validation.
+        -- Insert the constraints of the static form in a global list for later
+        -- validation.
         ; stWC <- tcg_static_wc <$> getGblEnv
         ; updTcRef stWC (andWC lie)
-        ; return $ mkHsWrapCo co $ HsStatic expr'
+        -- Wrap the static form with the 'fromStaticPtr' call.
+        ; fromStaticPtr <- newMethodFromName StaticOrigin fromStaticPtrName p_ty
+        ; let wrap = mkWpTyApps [expr_ty]
+        ; loc <- getSrcSpanM
+        ; return $ mkHsWrapCo co $ HsApp (L loc $ mkHsWrap wrap fromStaticPtr)
+                                         (L loc (HsStatic expr'))
         }
 
 {-

docs/users_guide/glasgow_exts.rst

@@ -11043,11 +11043,11 @@ Using static pointers
 
 Each reference is given a key which can be used to locate it at runtime
 with
-:base-ref:`unsafeLookupStaticPtr <GHC.StaticPtr.html#v%3AunsafeLookupStaticPtr>`
+:base-ref:`unsafeLookupStaticPtr <GHC-StaticPtr.html#v%3AunsafeLookupStaticPtr>`
 which uses a global and immutable table called the Static Pointer Table.
 The compiler includes entries in this table for all static forms found
 in the linked modules. The value can be obtained from the reference via
-:base-ref:`deRefStaticPtr <GHC.StaticPtr.html#v%3AdeRefStaticPtr>`.
+:base-ref:`deRefStaticPtr <GHC-StaticPtr.html#v%3AdeRefStaticPtr>`.
 
 The body ``e`` of a ``static e`` expression must be a closed expression.
 That is, there can be no free variables occurring in ``e``, i.e. lambda-
@@ -11080,7 +11080,23 @@ Informally, if we have a closed expression ::
 
 the static form is of type ::
 
-    static e :: (Typeable a_1, ... , Typeable a_n) => StaticPtr t
+    static e :: (IsStatic p, Typeable a_1, ... , Typeable a_n) => p t
+
+
+A static form determines a value of type ``StaticPtr t``, but just
+like ``OverloadedLists`` and ``OverloadedStrings``, this literal
+expression is overloaded to allow lifting a ``StaticPtr`` into another
+type implicitly, via the ``IsStatic`` class: ::
+
+    class IsStatic p where
+        fromStaticPtr :: StaticPtr a -> p a
+
+The only predefined instance is the obvious one that does nothing: ::
+
+    instance IsStatic StaticPtr where
+        fromStaticPtr sptr = sptr
+
+See :base-ref:`IsStatic <GHC-StaticPtr.html#t%3AIsStatic>`.
 
 Furthermore, type ``t`` is constrained to have a ``Typeable`` instance.
 The following are therefore illegal: ::

libraries/base/GHC/StaticPtr.hs

@@ -38,6 +38,7 @@ module GHC.StaticPtr
   , StaticPtrInfo(..)
   , staticPtrInfo
   , staticPtrKeys
+  , IsStatic(..)
   ) where
 
 import Foreign.C.Types     (CInt(..))
@@ -80,6 +81,13 @@ unsafeLookupStaticPtr (Fingerprint w1 w2) = do
 
 foreign import ccall unsafe hs_spt_lookup :: Ptr () -> IO (Ptr a)
 
+-- | A class for things buildable from static pointers.
+class IsStatic p where
+    fromStaticPtr :: StaticPtr a -> p a
+
+instance IsStatic StaticPtr where
+    fromStaticPtr = id
+
 -- | Miscelaneous information available for debugging purposes.
 data StaticPtrInfo = StaticPtrInfo
     { -- | Package key of the package where the static pointer is defined