[commit: ghc] master: Overload the static form to reduce verbosity. (c1efdcc)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/c1efdcc40209bc4f0ded85269eb8ba49c7d1ff09/ghc

>---------------------------------------------------------------

commit c1efdcc40209bc4f0ded85269eb8ba49c7d1ff09
Author: Facundo Domínguez <facundo.dominguez at tweag.io>
Date:   Thu Feb 25 14:33:43 2016 +0100

    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


>---------------------------------------------------------------

c1efdcc40209bc4f0ded85269eb8ba49c7d1ff09
 compiler/prelude/PrelNames.hs     |  8 ++++++++
 compiler/typecheck/TcExpr.hs      | 16 +++++++++++-----
 docs/users_guide/glasgow_exts.rst | 22 +++++++++++++++++++---
 libraries/base/GHC/StaticPtr.hs   |  8 ++++++++
 4 files changed, 46 insertions(+), 8 deletions(-)

diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index 068f276..cc18398 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/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
+
 {-
 ************************************************************************
 *                                                                      *
diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index 6d5fe09..b98e1de 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/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'))
         }
 
 {-
diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst
index 725f2ba..fc7ec52 100644
--- a/docs/users_guide/glasgow_exts.rst
+++ b/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: ::
diff --git a/libraries/base/GHC/StaticPtr.hs b/libraries/base/GHC/StaticPtr.hs
index 117d705..3d5807a 100644
--- a/libraries/base/GHC/StaticPtr.hs
+++ b/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