Commit 9129210f authored by Matthew Pickering's avatar Matthew Pickering Committed by Marge Bot

Overloaded Quotation Brackets (#246)

This patch implements overloaded quotation brackets which generalise the
desugaring of all quotation forms in terms of a new minimal interface.

The main change is that a quotation, for example, [e| 5 |], will now
have type `Quote m => m Exp` rather than `Q Exp`. The `Quote` typeclass
contains a single method for generating new names which is used when
desugaring binding structures.

The return type of functions from the `Lift` type class, `lift` and `liftTyped` have
been restricted to `forall m . Quote m => m Exp` rather than returning a
result in a Q monad.

More details about the feature can be read in the GHC proposal.

https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0246-overloaded-bracket.rst
parent 49f83a0d
Pipeline #14483 failed with stages
in 332 minutes and 13 seconds
......@@ -926,8 +926,10 @@ cpeApp top_env expr
(_ : ss_rest, True) -> (topDmd, ss_rest)
(ss1 : ss_rest, False) -> (ss1, ss_rest)
([], _) -> (topDmd, [])
(arg_ty, res_ty) = expectJust "cpeBody:collect_args" $
splitFunTy_maybe fun_ty
(arg_ty, res_ty) =
case splitFunTy_maybe fun_ty of
Just as -> as
Nothing -> pprPanic "cpeBody" (ppr fun_ty $$ ppr expr)
(fs, arg') <- cpeArg top_env ss1 arg arg_ty
rebuild_app as (App fun' arg') res_ty (fs `appendFloats` floats) ss_rest
CpeCast co ->
......
......@@ -451,6 +451,8 @@ data HsExpr p
| HsTcBracketOut
(XTcBracketOut p)
(Maybe QuoteWrapper) -- The wrapper to apply type and dictionary argument
-- to the quote.
(HsBracket GhcRn) -- Output of the type checker is the *original*
-- renamed expression, plus
[PendingTcSplice] -- _typechecked_ splices to be
......@@ -1006,8 +1008,8 @@ ppr_expr (HsSpliceE _ s) = pprSplice s
ppr_expr (HsBracket _ b) = pprHsBracket b
ppr_expr (HsRnBracketOut _ e []) = ppr e
ppr_expr (HsRnBracketOut _ e ps) = ppr e $$ text "pending(rn)" <+> ppr ps
ppr_expr (HsTcBracketOut _ e []) = ppr e
ppr_expr (HsTcBracketOut _ e ps) = ppr e $$ text "pending(tc)" <+> ppr ps
ppr_expr (HsTcBracketOut _ _wrap e []) = ppr e
ppr_expr (HsTcBracketOut _ _wrap e ps) = ppr e $$ text "pending(tc)" <+> ppr ps
ppr_expr (HsProc _ pat (L _ (HsCmdTop _ cmd)))
= hsep [text "proc", ppr pat, ptext (sLit "->"), ppr cmd]
......
......@@ -1004,7 +1004,7 @@ instance ( a ~ GhcPass p
[ toHie b
, toHie p
]
HsTcBracketOut _ b p ->
HsTcBracketOut _ _wrap b p ->
[ toHie b
, toHie p
]
......
......@@ -709,7 +709,7 @@ ds_expr _ expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields
-- Template Haskell stuff
ds_expr _ (HsRnBracketOut _ _ _) = panic "dsExpr HsRnBracketOut"
ds_expr _ (HsTcBracketOut _ x ps) = dsBracket x ps
ds_expr _ (HsTcBracketOut _ hs_wrapper x ps) = dsBracket hs_wrapper x ps
ds_expr _ (HsSpliceE _ s) = pprPanic "dsExpr:splice" (ppr s)
-- Arrow notation extension
......
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -224,6 +224,8 @@ import System.FilePath
import Control.Concurrent
import System.Process ( ProcessHandle )
import Control.DeepSeq
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Class
-- -----------------------------------------------------------------------------
-- Compilation state
......@@ -2324,6 +2326,10 @@ class Monad m => MonadThings m where
lookupTyCon :: Name -> m TyCon
lookupTyCon = liftM tyThingTyCon . lookupThing
-- Instance used in DsMeta
instance MonadThings m => MonadThings (ReaderT s m) where
lookupThing = lift . lookupThing
{-
************************************************************************
* *
......
This diff is collapsed.
......@@ -830,7 +830,7 @@ tcMetaTy :: Name -> TcM Type
-- E.g. given the name "Expr" return the type "Expr"
tcMetaTy tc_name = do
t <- tcLookupTyCon tc_name
return (mkTyConApp t [])
return (mkTyConTy t)
isBrackStage :: ThStage -> Bool
isBrackStage (Brack {}) = True
......
......@@ -4,14 +4,14 @@
module TcEvidence (
-- HsWrapper
-- * HsWrapper
HsWrapper(..),
(<.>), mkWpTyApps, mkWpEvApps, mkWpEvVarApps, mkWpTyLams,
mkWpLams, mkWpLet, mkWpCastN, mkWpCastR, collectHsWrapBinders,
mkWpFun, idHsWrapper, isIdHsWrapper, isErasableHsWrapper,
pprHsWrapper,
-- Evidence bindings
-- * Evidence bindings
TcEvBinds(..), EvBindsVar(..),
EvBindMap(..), emptyEvBindMap, extendEvBinds,
lookupEvBind, evBindMapBinds, foldEvBindMap, filterEvBindMap,
......@@ -19,7 +19,7 @@ module TcEvidence (
EvBind(..), emptyTcEvBinds, isEmptyTcEvBinds, mkGivenEvBind, mkWantedEvBind,
evBindVar, isCoEvBindsVar,
-- EvTerm (already a CoreExpr)
-- * EvTerm (already a CoreExpr)
EvTerm(..), EvExpr,
evId, evCoercion, evCast, evDFunApp, evDataConApp, evSelector,
mkEvCast, evVarsOfTerm, mkEvScSelectors, evTypeable, findNeededEvVars,
......@@ -28,7 +28,7 @@ module TcEvidence (
EvCallStack(..),
EvTypeable(..),
-- TcCoercion
-- * TcCoercion
TcCoercion, TcCoercionR, TcCoercionN, TcCoercionP, CoercionHole,
TcMCoercion,
Role(..), LeftOrRight(..), pickLR,
......@@ -45,7 +45,10 @@ module TcEvidence (
mkTcCoVarCo,
isTcReflCo, isTcReflexiveCo, isTcGReflMCo, tcCoToMCo,
tcCoercionRole,
unwrapIP, wrapIP
unwrapIP, wrapIP,
-- * QuoteWrapper
QuoteWrapper(..), applyQuoteWrapper, quoteWrapperTyVarTy
) where
#include "HsVersions.h"
......@@ -1002,3 +1005,25 @@ unwrapIP ty =
-- dictionary. See 'unwrapIP'.
wrapIP :: Type -> CoercionR
wrapIP ty = mkSymCo (unwrapIP ty)
----------------------------------------------------------------------
-- A datatype used to pass information when desugaring quotations
----------------------------------------------------------------------
-- We have to pass a `EvVar` and `Type` into `dsBracket` so that the
-- correct evidence and types are applied to all the TH combinators.
-- This data type bundles them up together with some convenience methods.
--
-- The EvVar is evidence for `Quote m`
-- The Type is a metavariable for `m`
--
data QuoteWrapper = QuoteWrapper EvVar Type deriving Data.Data
quoteWrapperTyVarTy :: QuoteWrapper -> Type
quoteWrapperTyVarTy (QuoteWrapper _ t) = t
-- | Convert the QuoteWrapper into a normal HsWrapper which can be used to
-- apply its contents.
applyQuoteWrapper :: QuoteWrapper -> HsWrapper
applyQuoteWrapper (QuoteWrapper ev_var m_var)
= mkWpEvVarApps [ev_var] <.> mkWpTyApps [m_var]
......@@ -1978,7 +1978,7 @@ checkCrossStageLifting :: TopLevelFlag -> Id -> ThStage -> TcM ()
-- This is similar to checkCrossStageLifting in GHC.Rename.Splice, but
-- this code is applied to *typed* brackets.
checkCrossStageLifting top_lvl id (Brack _ (TcPending ps_var lie_var))
checkCrossStageLifting top_lvl id (Brack _ (TcPending ps_var lie_var q))
| isTopLevel top_lvl
= when (isExternalName id_name) (keepAlive id_name)
-- See Note [Keeping things alive for Template Haskell] in GHC.Rename.Splice
......@@ -2015,7 +2015,8 @@ checkCrossStageLifting top_lvl id (Brack _ (TcPending ps_var lie_var))
-- Update the pending splices
; ps <- readMutVar ps_var
; let pending_splice = PendingTcSplice id_name
(nlHsApp (noLoc lift) (nlHsVar id))
(nlHsApp (mkLHsWrap (applyQuoteWrapper q) (noLoc lift))
(nlHsVar id))
; writeMutVar ps_var (pending_splice : ps)
; return () }
......
......@@ -798,12 +798,18 @@ zonkExpr env (HsAppType x e t)
zonkExpr _ e@(HsRnBracketOut _ _ _)
= pprPanic "zonkExpr: HsRnBracketOut" (ppr e)
zonkExpr env (HsTcBracketOut x body bs)
= do bs' <- mapM zonk_b bs
return (HsTcBracketOut x body bs')
zonkExpr env (HsTcBracketOut x wrap body bs)
= do wrap' <- traverse zonkQuoteWrap wrap
bs' <- mapM (zonk_b env) bs
return (HsTcBracketOut x wrap' body bs')
where
zonk_b (PendingTcSplice n e) = do e' <- zonkLExpr env e
return (PendingTcSplice n e')
zonkQuoteWrap (QuoteWrapper ev ty) = do
let ev' = zonkIdOcc env ev
ty' <- zonkTcTypeToTypeX env ty
return (QuoteWrapper ev' ty')
zonk_b env' (PendingTcSplice n e) = do e' <- zonkLExpr env' e
return (PendingTcSplice n e')
zonkExpr env (HsSpliceE _ (HsSplicedT s)) =
runTopSplice s >>= zonkExpr env
......
......@@ -17,6 +17,7 @@ module TcMType (
--------------------------------
-- Creating new mutable type variables
newFlexiTyVar,
newNamedFlexiTyVar,
newFlexiTyVarTy, -- Kind -> TcM TcType
newFlexiTyVarTys, -- Int -> Kind -> TcM [TcType]
newOpenFlexiTyVarTy, newOpenTypeKind,
......@@ -730,15 +731,22 @@ And there no reason /not/ to clone the Name when making a
unification variable. So that's what we do.
-}
metaInfoToTyVarName :: MetaInfo -> FastString
metaInfoToTyVarName meta_info =
case meta_info of
TauTv -> fsLit "t"
FlatMetaTv -> fsLit "fmv"
FlatSkolTv -> fsLit "fsk"
TyVarTv -> fsLit "a"
newAnonMetaTyVar :: MetaInfo -> Kind -> TcM TcTyVar
newAnonMetaTyVar mi = newNamedAnonMetaTyVar (metaInfoToTyVarName mi) mi
newNamedAnonMetaTyVar :: FastString -> MetaInfo -> Kind -> TcM TcTyVar
-- Make a new meta tyvar out of thin air
newAnonMetaTyVar meta_info kind
= do { let s = case meta_info of
TauTv -> fsLit "t"
FlatMetaTv -> fsLit "fmv"
FlatSkolTv -> fsLit "fsk"
TyVarTv -> fsLit "a"
; name <- newMetaTyVarName s
newNamedAnonMetaTyVar tyvar_name meta_info kind
= do { name <- newMetaTyVarName tyvar_name
; details <- newMetaDetails meta_info
; let tyvar = mkTcTyVar name kind details
; traceTc "newAnonMetaTyVar" (ppr tyvar)
......@@ -963,6 +971,10 @@ that can't ever appear in user code, so we're safe!
newFlexiTyVar :: Kind -> TcM TcTyVar
newFlexiTyVar kind = newAnonMetaTyVar TauTv kind
-- | Create a new flexi ty var with a specific name
newNamedFlexiTyVar :: FastString -> Kind -> TcM TcTyVar
newNamedFlexiTyVar fs kind = newNamedAnonMetaTyVar fs TauTv kind
newFlexiTyVarTy :: Kind -> TcM TcType
newFlexiTyVarTy kind = do
tc_tyvar <- newFlexiTyVar kind
......
......@@ -430,6 +430,7 @@ data CtOrigin
| HoleOrigin
| UnboundOccurrenceOf OccName
| ListOrigin -- An overloaded list
| BracketOrigin -- An overloaded quotation bracket
| StaticOrigin -- A static form
| FailablePattern (LPat GhcTcId) -- A failable pattern in do-notation for the
-- MonadFail Proposal (MFP). Obsolete when
......@@ -655,4 +656,5 @@ pprCtO AnnOrigin = text "an annotation"
pprCtO HoleOrigin = text "a use of" <+> quotes (text "_")
pprCtO ListOrigin = text "an overloaded list"
pprCtO StaticOrigin = text "a static form"
pprCtO BracketOrigin = text "a quotation bracket"
pprCtO _ = panic "pprCtOrigin"
......@@ -948,6 +948,13 @@ data PendingStuff
| TcPending -- Typechecking the inside of a typed bracket
(TcRef [PendingTcSplice]) -- Accumulate pending splices here
(TcRef WantedConstraints) -- and type constraints here
QuoteWrapper -- A type variable and evidence variable
-- for the overall monad of
-- the bracket. Splices are checked
-- against this monad. The evidence
-- variable is used for desugaring
-- `lift`.
topStage, topAnnStage, topSpliceStage :: ThStage
topStage = Comp
......
This diff is collapsed.
......@@ -32,6 +32,10 @@ Runtime system
Template Haskell
~~~~~~~~~~~~~~~~
- Implement the Overloaded Quotations proposal (#246). The type of all quotation
forms have now been generalised in terms of a minimal interface necessary for the
implementation rather than the overapproximation of the ``Q`` monad.
``ghc-prim`` library
~~~~~~~~~~~~~~~~~~~~
......
......@@ -13117,7 +13117,7 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under
overrides the meaning of "." as an infix operator. If you want the
infix operator, put spaces around it.
A splice can occur in place of
A top-level splice can occur in place of
- an expression; the spliced expression must have type ``Q Exp``
......@@ -13133,32 +13133,70 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under
that declaration splices are not allowed anywhere except at top level
(outside any other declarations).
The ``Q`` monad is a monad defined in ``Language.Haskell.TH.Syntax`` which
supports several useful operations during code generation such as reporting
errors or looking up identifiers in the environment.
- A expression quotation is written in Oxford brackets, thus:
- ``[| ... |]``, or ``[e| ... |]``, where the "..." is an
expression; the quotation has type ``Q Exp``.
expression; the quotation has type ``Quote m => m Exp``.
- ``[d| ... |]``, where the "..." is a list of top-level
declarations; the quotation has type ``Q [Dec]``.
declarations; the quotation has type ``Quote m => m [Dec]``.
- ``[t| ... |]``, where the "..." is a type; the quotation has type
``Q Type``.
``Quote m => m Type``.
- ``[p| ... |]``, where the "..." is a pattern; the quotation has
type ``Q Pat``.
type ``Quote m => m Pat``.
The ``Quote`` type class is the minimal interface necessary to implement
the desugaring of quotations. The ``Q`` monad is an instance of ``Quote`` but
contains many more operations which are not needed for defining quotations.
See :ref:`pts-where` for using partial type signatures in quotations.
- Splices can be nested inside quotation brackets. For example the fragment
representing ``1 + 2`` can be constructed using nested splices::
oneC, twoC, plusC :: Quote m => m Exp
oneC = [| 1 |]
twoC = [| 2 |]
plusC = [| $oneC + $twoC |]
- The precise type of a quotation depends on the types of the nested splices inside it::
-- Add a redundant constraint to demonstrate that constraints on the
-- monad used to build the representation are propagated when using nested
-- splices.
f :: (Quote m, C m) => m Exp
f = [| 5 | ]
-- f is used in a nested splice so the constraint on f, namely C, is propagated
-- to a constraint on the whole representation.
g :: (Quote m, C m) => m Exp
g = [| $f + $f |]
Remember, a top-level splice still requires its argument to be of type ``Q Exp``.
So then splicing in ``g`` will cause ``m`` to be instantiated to ``Q``::
h :: Int
h = $(g) -- m ~ Q
- A *typed* expression splice is written ``$$x``, where ``x`` is
is an arbitrary expression.
A typed expression splice can occur in place of an expression; the
A top-level typed expression splice can occur in place of an expression; the
spliced expression must have type ``Q (TExp a)``
- A *typed* expression quotation is written as ``[|| ... ||]``, or
``[e|| ... ||]``, where the "..." is an expression; if the "..."
expression has type ``a``, then the quotation has type
``Q (TExp a)``.
``Quote m => m (TExp a)``.
Values of type ``TExp a`` may be converted to values of type ``Exp``
using the function ``unType :: TExp a -> Exp``.
......@@ -13200,7 +13238,7 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under
import Language.Haskell.TH
add1 :: Int -> Q Exp
add1 :: Quote m => Int -> m Exp
add1 x = [| x + 1 |]
Now consider a splice using ``add1`` in a separate
......@@ -13215,13 +13253,14 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under
Template Haskell cannot know what the argument to ``add1`` will be at the
function's definition site, so a lifting mechanism is used to promote
``x`` into a value of type ``Q Exp``. This functionality is exposed to the
``x`` into a value of type ``Quote m => m Exp``. This functionality is exposed to the
user as the ``Lift`` typeclass in the ``Language.Haskell.TH.Syntax``
module. If a type has a ``Lift`` instance, then any of its values can be
lifted to a Template Haskell expression: ::
class Lift t where
lift :: t -> Q Exp
lift :: Quote m => t -> m Exp
liftTyped :: Quote m => t -> m (TExp t)
In general, if GHC sees an expression within Oxford brackets (e.g., ``[|
foo bar |]``, then GHC looks up each name within the brackets. If a name
......@@ -13265,14 +13304,14 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under
quotation bracket are *not* run at compile time; they are run when the
bracket is spliced in, sometime later. For example, ::
mkPat :: Q Pat
mkPat :: Quote m => m Pat
mkPat = [p| (x, y) |]
-- in another module:
foo :: (Char, String) -> String
foo $(mkPat) = x : z
bar :: Q Exp
bar :: Quote m => m Exp
bar = [| \ $(mkPat) -> x : w |]
will fail with ``z`` being out of scope in the definition of ``foo`` but it
......@@ -13402,7 +13441,7 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under
(Compared to the original paper, there are many differences of detail.
The syntax for a declaration splice uses "``$``" not "``splice``". The type of
the enclosed expression must be ``Q [Dec]``, not ``[Q Dec]``. Typed expression
the enclosed expression must be ``Quote m => m [Dec]``, not ``[Q Dec]``. Typed expression
splices and quotations are supported.)
.. ghc-flag:: -fenable-th-splice-warnings
......@@ -13538,14 +13577,14 @@ and :file:`Printf.hs`:
-- Generate Haskell source code from a parsed representation
-- of the format string. This code will be spliced into
-- the module which calls "pr", at compile time.
gen :: [Format] -> Q Exp
gen :: Quote m => [Format] -> m Exp
gen [D] = [| \n -> show n |]
gen [S] = [| \s -> s |]
gen [L s] = stringE s
-- Here we generate the Haskell code for the splice
-- from an input format string.
pr :: String -> Q Exp
pr :: Quote m => String -> m Exp
pr s = gen (parse s)
Now run the compiler,
......
......@@ -8,6 +8,7 @@ module Language.Haskell.TH(
-- * The monad and its operations
Q,
runQ,
Quote(..),
-- ** Administration: errors, locations and IO
reportError, -- :: String -> Q ()
reportWarning, -- :: String -> Q ()
......@@ -53,7 +54,6 @@ module Language.Haskell.TH(
Name, NameSpace, -- Abstract
-- ** Constructing names
mkName, -- :: String -> Name
newName, -- :: String -> Q Name
-- ** Deconstructing names
nameBase, -- :: Name -> String
nameModule, -- :: Name -> Maybe String
......@@ -84,7 +84,7 @@ module Language.Haskell.TH(
Pat(..), FieldExp, FieldPat,
-- ** Types
Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred, Syntax.Role(..),
FamilyResultSig(..), Syntax.InjectivityAnn(..), PatSynType,
FamilyResultSig(..), Syntax.InjectivityAnn(..), PatSynType, BangType, VarBangType,
-- * Library functions
module Language.Haskell.TH.Lib,
......
......@@ -159,7 +159,7 @@ import Language.Haskell.TH.Lib.Internal hiding
)
import Language.Haskell.TH.Syntax
import Control.Monad (liftM2)
import Control.Applicative ( liftA2 )
import Foreign.ForeignPtr
import Data.Word
import Prelude
......@@ -172,97 +172,97 @@ import Prelude
-------------------------------------------------------------------------------
-- * Dec
tySynD :: Name -> [TyVarBndr] -> TypeQ -> DecQ
tySynD :: Quote m => Name -> [TyVarBndr] -> m Type -> m Dec
tySynD tc tvs rhs = do { rhs1 <- rhs; return (TySynD tc tvs rhs1) }
dataD :: CxtQ -> Name -> [TyVarBndr] -> Maybe Kind -> [ConQ] -> [DerivClauseQ]
-> DecQ
dataD :: Quote m => m Cxt -> Name -> [TyVarBndr] -> Maybe Kind -> [m Con] -> [m DerivClause]
-> m Dec
dataD ctxt tc tvs ksig cons derivs =
do
ctxt1 <- ctxt
cons1 <- sequence cons
derivs1 <- sequence derivs
cons1 <- sequenceA cons
derivs1 <- sequenceA derivs
return (DataD ctxt1 tc tvs ksig cons1 derivs1)
newtypeD :: CxtQ -> Name -> [TyVarBndr] -> Maybe Kind -> ConQ -> [DerivClauseQ]
-> DecQ
newtypeD :: Quote m => m Cxt -> Name -> [TyVarBndr] -> Maybe Kind -> m Con -> [m DerivClause]
-> m Dec
newtypeD ctxt tc tvs ksig con derivs =
do
ctxt1 <- ctxt
con1 <- con
derivs1 <- sequence derivs
derivs1 <- sequenceA derivs
return (NewtypeD ctxt1 tc tvs ksig con1 derivs1)
classD :: CxtQ -> Name -> [TyVarBndr] -> [FunDep] -> [DecQ] -> DecQ
classD :: Quote m => m Cxt -> Name -> [TyVarBndr] -> [FunDep] -> [m Dec] -> m Dec
classD ctxt cls tvs fds decs =
do
decs1 <- sequence decs
decs1 <- sequenceA decs
ctxt1 <- ctxt
return $ ClassD ctxt1 cls tvs fds decs1
pragRuleD :: String -> [RuleBndrQ] -> ExpQ -> ExpQ -> Phases -> DecQ
pragRuleD :: Quote m => String -> [m RuleBndr] -> m Exp -> m Exp -> Phases -> m Dec
pragRuleD n bndrs lhs rhs phases
= do
bndrs1 <- sequence bndrs
bndrs1 <- sequenceA bndrs
lhs1 <- lhs
rhs1 <- rhs
return $ PragmaD $ RuleP n Nothing bndrs1 lhs1 rhs1 phases
dataInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> [ConQ] -> [DerivClauseQ]
-> DecQ
dataInstD :: Quote m => m Cxt -> Name -> [m Type] -> Maybe Kind -> [m Con] -> [m DerivClause]
-> m Dec
dataInstD ctxt tc tys ksig cons derivs =
do
ctxt1 <- ctxt
ty1 <- foldl appT (conT tc) tys
cons1 <- sequence cons
derivs1 <- sequence derivs
cons1 <- sequenceA cons
derivs1 <- sequenceA derivs
return (DataInstD ctxt1 Nothing ty1 ksig cons1 derivs1)
newtypeInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> ConQ -> [DerivClauseQ]
-> DecQ
newtypeInstD :: Quote m => m Cxt -> Name -> [m Type] -> Maybe Kind -> m Con -> [m DerivClause]
-> m Dec
newtypeInstD ctxt tc tys ksig con derivs =
do
ctxt1 <- ctxt
ty1 <- foldl appT (conT tc) tys
con1 <- con
derivs1 <- sequence derivs
derivs1 <- sequenceA derivs
return (NewtypeInstD ctxt1 Nothing ty1 ksig con1 derivs1)
dataFamilyD :: Name -> [TyVarBndr] -> Maybe Kind -> DecQ
dataFamilyD :: Quote m => Name -> [TyVarBndr] -> Maybe Kind -> m Dec
dataFamilyD tc tvs kind
= return $ DataFamilyD tc tvs kind
= pure $ DataFamilyD tc tvs kind
openTypeFamilyD :: Name -> [TyVarBndr] -> FamilyResultSig
-> Maybe InjectivityAnn -> DecQ
openTypeFamilyD :: Quote m => Name -> [TyVarBndr] -> FamilyResultSig
-> Maybe InjectivityAnn -> m Dec
openTypeFamilyD tc tvs res inj
= return $ OpenTypeFamilyD (TypeFamilyHead tc tvs res inj)
= pure $ OpenTypeFamilyD (TypeFamilyHead tc tvs res inj)
closedTypeFamilyD :: Name -> [TyVarBndr] -> FamilyResultSig
-> Maybe InjectivityAnn -> [TySynEqnQ] -> DecQ
closedTypeFamilyD :: Quote m => Name -> [TyVarBndr] -> FamilyResultSig
-> Maybe InjectivityAnn -> [m TySynEqn] -> m Dec
closedTypeFamilyD tc tvs result injectivity eqns =
do eqns1 <- sequence eqns
do eqns1 <- sequenceA eqns
return (ClosedTypeFamilyD (TypeFamilyHead tc tvs result injectivity) eqns1)
tySynEqn :: (Maybe [TyVarBndr]) -> TypeQ -> TypeQ -> TySynEqnQ
tySynEqn :: Quote m => (Maybe [TyVarBndr]) -> m Type -> m Type -> m TySynEqn
tySynEqn tvs lhs rhs =
do
lhs1 <- lhs
rhs1 <- rhs
return (TySynEqn tvs lhs1 rhs1)
forallC :: [TyVarBndr] -> CxtQ -> ConQ -> ConQ
forallC ns ctxt con = liftM2 (ForallC ns) ctxt con
forallC :: Quote m => [TyVarBndr] -> m Cxt -> m Con -> m Con
forallC ns ctxt con = liftA2 (ForallC ns) ctxt con
-------------------------------------------------------------------------------
-- * Type
forallT :: [TyVarBndr] -> CxtQ -> TypeQ -> TypeQ
forallT :: Quote m => [TyVarBndr] -> m Cxt -> m Type -> m Type
forallT tvars ctxt ty = do
ctxt1 <- ctxt
ty1 <- ty
return $ ForallT tvars ctxt1 ty1
sigT :: TypeQ -> Kind -> TypeQ
sigT :: Quote m => m Type -> Kind -> m Type
sigT t k
= do
t' <- t
......@@ -298,12 +298,12 @@ tyVarSig = TyVarSig
-------------------------------------------------------------------------------
-- * Top Level Declarations
derivClause :: Maybe DerivStrategy -> [PredQ] -> DerivClauseQ
derivClause :: Quote m => Maybe DerivStrategy -> [m Pred] -> m DerivClause
derivClause mds p = do
p' <- cxt p
return $ DerivClause mds p'
standaloneDerivWithStrategyD :: Maybe DerivStrategy -> CxtQ -> TypeQ -> DecQ
standaloneDerivWithStrategyD :: Quote m => Maybe DerivStrategy -> m Cxt -> m Type -> m Dec
standaloneDerivWithStrategyD mds ctxt ty = do
ctxt' <- ctxt
ty' <- ty
......@@ -326,8 +326,8 @@ mkBytes = Bytes
-------------------------------------------------------------------------------
-- * Tuple expressions
tupE :: [ExpQ] -> ExpQ
tupE es = do { es1 <- sequence es; return (TupE $ map Just es1)}
tupE :: Quote m => [m Exp] -> m Exp
tupE es = do { es1 <- sequenceA es; return (TupE $ map Just es1)}
unboxedTupE :: [ExpQ] -> ExpQ
unboxedTupE es = do { es1 <- sequence es; return (UnboxedTupE $ map Just es1)}
unboxedTupE :: Quote m => [m Exp] -> m Exp
unboxedTupE es = do { es1 <- sequenceA es; return (UnboxedTupE $ map Just es1)}
......@@ -202,6 +202,67 @@ instance Applicative Q where
Q f <*> Q x = Q (f <*> x)
Q m *> Q n = Q (m *> n)
-----------------------------------------------------
--
-- The Quote class
--
-----------------------------------------------------