[commit: ghc] ghc-8.0: Overload the static form to reduce verbosity. (70287bc)
git at git.haskell.org
git at git.haskell.org
Sat Feb 27 15:21:09 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : ghc-8.0
Link : http://ghc.haskell.org/trac/ghc/changeset/70287bceb5a339456179f08bfbe64c4fe2ff718a/ghc
>---------------------------------------------------------------
commit 70287bceb5a339456179f08bfbe64c4fe2ff718a
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
(cherry picked from commit c1efdcc40209bc4f0ded85269eb8ba49c7d1ff09)
>---------------------------------------------------------------
70287bceb5a339456179f08bfbe64c4fe2ff718a
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 5c2984b..c32a4ee 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
@@ -2166,6 +2171,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 9b875b5..2fecfc3 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 c39e436..0234955 100644
--- a/docs/users_guide/glasgow_exts.rst
+++ b/docs/users_guide/glasgow_exts.rst
@@ -11047,11 +11047,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-
@@ -11084,7 +11084,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
More information about the ghc-commits
mailing list