[commit: packages/template-haskell] master: Support new role annotation syntax. (c17c492)
git at git.haskell.org
git at git.haskell.org
Wed Sep 18 03:41:26 CEST 2013
Repository : ssh://git@git.haskell.org/template-haskell
On branch : master
Link : http://git.haskell.org/?p=packages/template-haskell.git;a=commit;h=c17c49227bd214d45c9d7b9d39f61713d00f3b70
>---------------------------------------------------------------
commit c17c49227bd214d45c9d7b9d39f61713d00f3b70
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date: Wed Sep 11 00:56:03 2013 -0400
Support new role annotation syntax.
This reverts the change to TyVarBndr (which now has only two
constructors, PlainTV and KindedTV) and adds a new Dec, RoleAnnotD.
There is also an updated definition for the type Role, to allow
for wildcard annotations.
>---------------------------------------------------------------
c17c49227bd214d45c9d7b9d39f61713d00f3b70
Language/Haskell/TH.hs | 11 +++++++++--
Language/Haskell/TH/Lib.hs | 22 +++++++++++-----------
Language/Haskell/TH/Ppr.hs | 12 ++++++------
Language/Haskell/TH/Syntax.hs | 21 ++++++++++++++++-----
4 files changed, 42 insertions(+), 24 deletions(-)
diff --git a/Language/Haskell/TH.hs b/Language/Haskell/TH.hs
index 5064b6a..38c91fe 100644
--- a/Language/Haskell/TH.hs
+++ b/Language/Haskell/TH.hs
@@ -30,6 +30,8 @@ module Language.Haskell.TH(
-- *** Instance lookup
reifyInstances,
isInstance,
+ -- *** Roles lookup
+ reifyRoles,
-- * Names
Name, NameSpace, -- Abstract
@@ -59,7 +61,7 @@ module Language.Haskell.TH(
-- ** Patterns
Pat(..), FieldExp, FieldPat,
-- ** Types
- Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred(..), Role(..),
+ Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred(..), Syntax.Role(..),
-- * Library functions
-- ** Abbreviations
@@ -108,11 +110,16 @@ module Language.Haskell.TH(
-- *** Kinds
varK, conK, tupleK, arrowK, listK, appK, starK, constraintK,
+ -- *** Roles
+ nominalR, representationalR, phantomR, inferR,
+
-- *** Top Level Declarations
-- **** Data
valD, funD, tySynD, dataD, newtypeD,
-- **** Class
classD, instanceD, sigD,
+ -- **** Role annotations
+ roleAnnotD,
-- **** Type Family / Data Family
familyNoKindD, familyKindD, dataInstD,
closedTypeFamilyNoKindD, closedTypeFamilyKindD,
@@ -129,7 +136,7 @@ module Language.Haskell.TH(
) where
-import Language.Haskell.TH.Syntax
+import Language.Haskell.TH.Syntax as Syntax
import Language.Haskell.TH.Lib
import Language.Haskell.TH.Ppr
diff --git a/Language/Haskell/TH/Lib.hs b/Language/Haskell/TH/Lib.hs
index b02732c..94696b8 100644
--- a/Language/Haskell/TH/Lib.hs
+++ b/Language/Haskell/TH/Lib.hs
@@ -7,7 +7,8 @@ module Language.Haskell.TH.Lib where
-- be "public" functions. The main module TH
-- re-exports them all.
-import Language.Haskell.TH.Syntax
+import Language.Haskell.TH.Syntax hiding (Role)
+import qualified Language.Haskell.TH.Syntax as TH
import Control.Monad( liftM, liftM2 )
import Data.Word( Word8 )
@@ -37,6 +38,7 @@ type VarStrictTypeQ = Q VarStrictType
type FieldExpQ = Q FieldExp
type RuleBndrQ = Q RuleBndr
type TySynEqnQ = Q TySynEqn
+type Role = TH.Role -- must be defined here for DsMeta to find it
----------------------------------------------------------
-- * Lowercase pattern syntax functions
@@ -442,6 +444,9 @@ closedTypeFamilyKindD tc tvs kind eqns =
eqns1 <- sequence eqns
return (ClosedTypeFamilyD tc tvs (Just kind) eqns1)
+roleAnnotD :: Name -> [Role] -> DecQ
+roleAnnotD name roles = return $ RoleAnnotD name roles
+
tySynEqn :: [TypeQ] -> TypeQ -> TySynEqnQ
tySynEqn lhs rhs =
do
@@ -566,12 +571,6 @@ plainTV = PlainTV
kindedTV :: Name -> Kind -> TyVarBndr
kindedTV = KindedTV
-roledTV :: Name -> Role -> TyVarBndr
-roledTV = RoledTV
-
-kindedRoledTV :: Name -> Kind -> Role -> TyVarBndr
-kindedRoledTV = KindedRoledTV
-
varK :: Name -> Kind
varK = VarT
@@ -599,10 +598,11 @@ constraintK = ConstraintT
-------------------------------------------------------------------------------
-- * Role
-nominal, representational, phantom :: Role
-nominal = Nominal
-representational = Representational
-phantom = Phantom
+nominalR, representationalR, phantomR, inferR :: Role
+nominalR = NominalR
+representationalR = RepresentationalR
+phantomR = PhantomR
+inferR = InferR
-------------------------------------------------------------------------------
-- * Callconv
diff --git a/Language/Haskell/TH/Ppr.hs b/Language/Haskell/TH/Ppr.hs
index 415f171..8222085 100644
--- a/Language/Haskell/TH/Ppr.hs
+++ b/Language/Haskell/TH/Ppr.hs
@@ -307,6 +307,8 @@ ppr_dec _ (ClosedTypeFamilyD tc tvs mkind eqns)
ppr_eqn (TySynEqn lhs rhs)
= ppr tc <+> sep (map pprParendType lhs) <+> text "=" <+> ppr rhs
+ppr_dec _ (RoleAnnotD name roles)
+ = hsep [ text "type role", ppr name ] <+> hsep (map ppr roles)
ppr_data :: Doc -> Cxt -> Name -> Doc -> [Con] -> [Name] -> Doc
ppr_data maybeInst ctxt t argsDoc cs decs
@@ -502,14 +504,12 @@ instance Ppr TyLit where
instance Ppr TyVarBndr where
ppr (PlainTV nm) = ppr nm
ppr (KindedTV nm k) = parens (ppr nm <+> text "::" <+> ppr k)
- ppr (RoledTV nm r) = ppr nm <> text "@" <> ppr r
- ppr (KindedRoledTV nm k r)
- = parens (ppr nm <+> text "::" <+> ppr k) <> text "@" <> ppr r
instance Ppr Role where
- ppr Nominal = text "N"
- ppr Representational = text "R"
- ppr Phantom = text "P"
+ ppr NominalR = text "nominal"
+ ppr RepresentationalR = text "representational"
+ ppr PhantomR = text "phantom"
+ ppr InferR = text "_"
------------------------------
pprCxt :: Cxt -> Doc
diff --git a/Language/Haskell/TH/Syntax.hs b/Language/Haskell/TH/Syntax.hs
index 2995b58..e53c787 100644
--- a/Language/Haskell/TH/Syntax.hs
+++ b/Language/Haskell/TH/Syntax.hs
@@ -54,6 +54,7 @@ class (Monad m, Applicative m) => Quasi m where
-- Returns list of matching instance Decs
-- (with empty sub-Decs)
-- Works for classes and type functions
+ qReifyRoles :: Name -> m [Role]
qLocation :: m Loc
@@ -84,6 +85,7 @@ instance Quasi IO where
qLookupName _ _ = badIO "lookupName"
qReify _ = badIO "reify"
qReifyInstances _ _ = badIO "classInstances"
+ qReifyRoles _ = badIO "reifyRoles"
qLocation = badIO "currentLocation"
qRecover _ _ = badIO "recover" -- Maybe we could fix this?
qAddDependentFile _ = badIO "addDependentFile"
@@ -288,6 +290,13 @@ all instances of this family at the types @tys@ are returned.
reifyInstances :: Name -> [Type] -> Q [InstanceDec]
reifyInstances cls tys = Q (qReifyInstances cls tys)
+{- | @reifyRoles nm@ returns the list of roles associated with the parameters of
+the tycon @nm at . Fails if @nm@ cannot be found or is not a tycon.
+The returned list should never contain 'InferR'.
+-}
+reifyRoles :: Name -> Q [Role]
+reifyRoles nm = Q (qReifyRoles nm)
+
-- | Is the list of instances returned by 'reifyInstances' nonempty?
isInstance :: Name -> [Type] -> Q Bool
isInstance nm tys = do { decs <- reifyInstances nm tys
@@ -320,6 +329,7 @@ instance Quasi Q where
qRecover = recover
qReify = reify
qReifyInstances = reifyInstances
+ qReifyRoles = reifyRoles
qLookupName = lookupName
qLocation = location
qRunIO = runIO
@@ -1170,6 +1180,8 @@ data Dec
| ClosedTypeFamilyD Name
[TyVarBndr] (Maybe Kind)
[TySynEqn] -- ^ @{ type family F a b :: * where ... }@
+
+ | RoleAnnotD Name [Role] -- ^ @{ type role T nominal representational }@
deriving( Show, Eq, Data, Typeable )
-- | One equation of a type family instance or closed type family. The
@@ -1258,8 +1270,6 @@ data Type = ForallT [TyVarBndr] Cxt Type -- ^ @forall \<vars\>. \<ctxt\> -> \<t
data TyVarBndr = PlainTV Name -- ^ @a@
| KindedTV Name Kind -- ^ @(a :: k)@
- | RoledTV Name Role -- ^ @a\@R@
- | KindedRoledTV Name Kind Role -- ^ @(a :: k)\@R@
deriving( Show, Eq, Data, Typeable )
data TyLit = NumTyLit Integer -- ^ @2@
@@ -1267,9 +1277,10 @@ data TyLit = NumTyLit Integer -- ^ @2@
deriving ( Show, Eq, Data, Typeable )
-- | Role annotations
-data Role = Nominal -- ^ @N@
- | Representational -- ^ @R@
- | Phantom -- ^ @P@
+data Role = NominalR -- ^ @nominal@
+ | RepresentationalR -- ^ @representational@
+ | PhantomR -- ^ @phantom@
+ | InferR -- ^ @_@
deriving( Show, Eq, Data, Typeable )
-- | To avoid duplication between kinds and types, they
More information about the ghc-commits
mailing list