[Git][ghc/ghc][wip/proposal-195] Use a newtype `Code` for the return type of typed quotations (Proposal #195)
Matthew Pickering
gitlab at gitlab.haskell.org
Wed May 27 11:03:17 UTC 2020
Matthew Pickering pushed to branch wip/proposal-195 at Glasgow Haskell Compiler / GHC
Commits:
74a756df by Matthew Pickering at 2020-05-27T12:02:59+01:00
Use a newtype `Code` for the return type of typed quotations (Proposal #195)
There are three problems with the current API:
1. It is hard to properly write instances for ``Quote m => m (TExp a)`` as the type is the composition
of two type constructors. Doing so in your program involves making your own newtype and
doing a lot of wrapping/unwrapping.
For example, if I want to create a language which I can either run immediately or
generate code from I could write the following with the new API. ::
class Lang r where
_int :: Int -> r Int
_if :: r Bool -> r a -> r a -> r a
instance Lang Identity where
_int = Identity
_if (Identity b) (Identity t) (Identity f) = Identity (if b then t else f)
instance Quote m => Lang (Code m) where
_int = liftTyped
_if cb ct cf = [|| if $$cb then $$ct else $$cf ||]
2. When doing code generation it is common to want to store code fragments in
a map. When doing typed code generation, these code fragments contain a
type index so it is desirable to store them in one of the parameterised
map data types such as ``DMap`` from ``dependent-map`` or ``MapF`` from
``parameterized-utils``.
::
compiler :: Env -> AST a -> Code Q a
data AST a where ...
data Ident a = ...
type Env = MapF Ident (Code Q)
newtype Code m a = Code (m (TExp a))
In this example, the ``MapF`` maps an ``Ident String`` directly to a ``Code Q String``.
Using one of these map types currently requires creating your own newtype and constantly
wrapping every quotation and unwrapping it when using a splice. Achievable, but
it creates even more syntactic noise than normal metaprogramming.
3. ``m (TExp a)`` is ugly to read and write, understanding ``Code m a`` is
easier. This is a weak reason but one everyone
can surely agree with.
- - - - -
27 changed files:
- compiler/GHC/Builtin/Names/TH.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- compiler/GHC/Tc/Gen/Splice.hs
- docs/users_guide/exts/deriving_extra.rst
- docs/users_guide/exts/template_haskell.rst
- libraries/template-haskell/Language/Haskell/TH.hs
- + libraries/template-haskell/Language/Haskell/TH/CodeDo.hs
- libraries/template-haskell/Language/Haskell/TH/Lib.hs
- libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
- libraries/template-haskell/changelog.md
- libraries/template-haskell/template-haskell.cabal.in
- libraries/text
- testsuite/tests/quotes/T17857.hs
- testsuite/tests/th/T10945.stderr
- testsuite/tests/th/T15471A.hs
- testsuite/tests/th/T15843.hs
- testsuite/tests/th/T16195A.hs
- testsuite/tests/th/T18121.hs
- testsuite/tests/th/T8577.stderr
- testsuite/tests/th/T8577a.hs
- testsuite/tests/th/TH_StringLift.hs
- testsuite/tests/th/TH_reifyLocalDefs.hs
- testsuite/tests/th/overloaded/T17839.hs
- testsuite/tests/th/overloaded/TH_overloaded_constraints.hs
- testsuite/tests/th/overloaded/TH_overloaded_csp.hs
- testsuite/tests/th/overloaded/TH_overloaded_extract.hs
Changes:
=====================================
compiler/GHC/Builtin/Names/TH.hs
=====================================
@@ -31,9 +31,8 @@ templateHaskellNames = [
mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
mkNameSName,
liftStringName,
- unTypeName,
- unTypeQName,
- unsafeTExpCoerceName,
+ unTypeName, unTypeCodeName,
+ unsafeCodeCoerceName,
-- Lit
charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
@@ -134,8 +133,6 @@ templateHaskellNames = [
-- DerivStrategy
stockStrategyName, anyclassStrategyName,
newtypeStrategyName, viaStrategyName,
- -- TExp
- tExpDataConName,
-- RuleBndr
ruleVarName, typedRuleVarName,
-- FunDep
@@ -158,7 +155,7 @@ templateHaskellNames = [
typeTyConName, tyVarBndrUnitTyConName, tyVarBndrSpecTyConName, clauseTyConName,
patQTyConName, funDepTyConName, decsQTyConName,
ruleBndrTyConName, tySynEqnTyConName,
- roleTyConName, tExpTyConName, injAnnTyConName, kindTyConName,
+ roleTyConName, codeTyConName, injAnnTyConName, kindTyConName,
overlapTyConName, derivClauseTyConName, derivStrategyTyConName,
-- Quasiquoting
@@ -191,7 +188,7 @@ quoteClassName = thCls (fsLit "Quote") quoteClassKey
qTyConName, nameTyConName, fieldExpTyConName, patTyConName,
fieldPatTyConName, expTyConName, decTyConName, typeTyConName,
matchTyConName, clauseTyConName, funDepTyConName, predTyConName,
- tExpTyConName, injAnnTyConName, overlapTyConName, decsTyConName :: Name
+ codeTyConName, injAnnTyConName, overlapTyConName, decsTyConName :: Name
qTyConName = thTc (fsLit "Q") qTyConKey
nameTyConName = thTc (fsLit "Name") nameTyConKey
fieldExpTyConName = thTc (fsLit "FieldExp") fieldExpTyConKey
@@ -205,14 +202,14 @@ matchTyConName = thTc (fsLit "Match") matchTyConKey
clauseTyConName = thTc (fsLit "Clause") clauseTyConKey
funDepTyConName = thTc (fsLit "FunDep") funDepTyConKey
predTyConName = thTc (fsLit "Pred") predTyConKey
-tExpTyConName = thTc (fsLit "TExp") tExpTyConKey
+codeTyConName = thTc (fsLit "Code") codeTyConKey
injAnnTyConName = thTc (fsLit "InjectivityAnn") injAnnTyConKey
overlapTyConName = thTc (fsLit "Overlap") overlapTyConKey
returnQName, bindQName, sequenceQName, newNameName, liftName,
mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName,
- mkNameLName, mkNameSName, liftStringName, unTypeName, unTypeQName,
- unsafeTExpCoerceName, liftTypedName :: Name
+ mkNameLName, mkNameSName, liftStringName, unTypeName, unTypeCodeName,
+ unsafeCodeCoerceName, liftTypedName :: Name
returnQName = thFun (fsLit "returnQ") returnQIdKey
bindQName = thFun (fsLit "bindQ") bindQIdKey
sequenceQName = thFun (fsLit "sequenceQ") sequenceQIdKey
@@ -226,8 +223,8 @@ mkNameG_tcName = thFun (fsLit "mkNameG_tc") mkNameG_tcIdKey
mkNameLName = thFun (fsLit "mkNameL") mkNameLIdKey
mkNameSName = thFun (fsLit "mkNameS") mkNameSIdKey
unTypeName = thFun (fsLit "unType") unTypeIdKey
-unTypeQName = thFun (fsLit "unTypeQ") unTypeQIdKey
-unsafeTExpCoerceName = thFun (fsLit "unsafeTExpCoerce") unsafeTExpCoerceIdKey
+unTypeCodeName = thFun (fsLit "unTypeCode") unTypeCodeIdKey
+unsafeCodeCoerceName = thFun (fsLit "unsafeCodeCoerce") unsafeCodeCoerceIdKey
liftTypedName = thFun (fsLit "liftTyped") liftTypedIdKey
@@ -519,10 +516,6 @@ unsafeName = libFun (fsLit "unsafe") unsafeIdKey
safeName = libFun (fsLit "safe") safeIdKey
interruptibleName = libFun (fsLit "interruptible") interruptibleIdKey
--- newtype TExp a = ...
-tExpDataConName :: Name
-tExpDataConName = thCon (fsLit "TExp") tExpDataConKey
-
-- data RuleBndr = ...
ruleVarName, typedRuleVarName :: Name
ruleVarName = libFun (fsLit ("ruleVar")) ruleVarIdKey
@@ -647,7 +640,7 @@ expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey,
fieldExpTyConKey, fieldPatTyConKey, nameTyConKey, patQTyConKey,
funDepTyConKey, predTyConKey,
predQTyConKey, decsQTyConKey, ruleBndrTyConKey, tySynEqnTyConKey,
- roleTyConKey, tExpTyConKey, injAnnTyConKey, kindTyConKey,
+ roleTyConKey, tExpTyConKey, codeTyConKey, injAnnTyConKey, kindTyConKey,
overlapTyConKey, derivClauseTyConKey, derivStrategyTyConKey, decsTyConKey
:: Unique
expTyConKey = mkPreludeTyConUnique 200
@@ -671,7 +664,6 @@ funDepTyConKey = mkPreludeTyConUnique 222
predTyConKey = mkPreludeTyConUnique 223
predQTyConKey = mkPreludeTyConUnique 224
tyVarBndrUnitTyConKey = mkPreludeTyConUnique 225
-tyVarBndrSpecTyConKey = mkPreludeTyConUnique 237
decsQTyConKey = mkPreludeTyConUnique 226
ruleBndrTyConKey = mkPreludeTyConUnique 227
tySynEqnTyConKey = mkPreludeTyConUnique 228
@@ -683,6 +675,8 @@ overlapTyConKey = mkPreludeTyConUnique 233
derivClauseTyConKey = mkPreludeTyConUnique 234
derivStrategyTyConKey = mkPreludeTyConUnique 235
decsTyConKey = mkPreludeTyConUnique 236
+tyVarBndrSpecTyConKey = mkPreludeTyConUnique 237
+codeTyConKey = mkPreludeTyConUnique 238
{- *********************************************************************
* *
@@ -710,10 +704,6 @@ allPhasesDataConKey = mkPreludeDataConUnique 205
fromPhaseDataConKey = mkPreludeDataConUnique 206
beforePhaseDataConKey = mkPreludeDataConUnique 207
--- newtype TExp a = ...
-tExpDataConKey :: Unique
-tExpDataConKey = mkPreludeDataConUnique 208
-
-- data Overlap = ..
overlappableDataConKey,
overlappingDataConKey,
@@ -735,8 +725,8 @@ incoherentDataConKey = mkPreludeDataConUnique 212
returnQIdKey, bindQIdKey, sequenceQIdKey, liftIdKey, newNameIdKey,
mkNameIdKey, mkNameG_vIdKey, mkNameG_dIdKey, mkNameG_tcIdKey,
- mkNameLIdKey, mkNameSIdKey, unTypeIdKey, unTypeQIdKey,
- unsafeTExpCoerceIdKey, liftTypedIdKey :: Unique
+ mkNameLIdKey, mkNameSIdKey, unTypeIdKey, unTypeCodeIdKey,
+ liftTypedIdKey, unsafeCodeCoerceIdKey :: Unique
returnQIdKey = mkPreludeMiscIdUnique 200
bindQIdKey = mkPreludeMiscIdUnique 201
sequenceQIdKey = mkPreludeMiscIdUnique 202
@@ -749,9 +739,9 @@ mkNameG_tcIdKey = mkPreludeMiscIdUnique 208
mkNameLIdKey = mkPreludeMiscIdUnique 209
mkNameSIdKey = mkPreludeMiscIdUnique 210
unTypeIdKey = mkPreludeMiscIdUnique 211
-unTypeQIdKey = mkPreludeMiscIdUnique 212
-unsafeTExpCoerceIdKey = mkPreludeMiscIdUnique 213
+unTypeCodeIdKey = mkPreludeMiscIdUnique 212
liftTypedIdKey = mkPreludeMiscIdUnique 214
+unsafeCodeCoerceIdKey = mkPreludeMiscIdUnique 215
-- data Lit = ...
@@ -1093,9 +1083,10 @@ inferredSpecKey = mkPreludeMiscIdUnique 499
************************************************************************
-}
-lift_RDR, liftTyped_RDR, mkNameG_dRDR, mkNameG_vRDR :: RdrName
+lift_RDR, liftTyped_RDR, mkNameG_dRDR, mkNameG_vRDR, unsafeCodeCoerce_RDR :: RdrName
lift_RDR = nameRdrName liftName
liftTyped_RDR = nameRdrName liftTypedName
+unsafeCodeCoerce_RDR = nameRdrName unsafeCodeCoerceName
mkNameG_dRDR = nameRdrName mkNameG_dName
mkNameG_vRDR = nameRdrName mkNameG_vName
=====================================
compiler/GHC/Tc/Deriv/Generate.hs
=====================================
@@ -1576,7 +1576,7 @@ gen_Lift_binds loc tycon = (listToBag [lift_bind, liftTyped_bind], emptyBag)
where
lift_bind = mkFunBindEC 1 loc lift_RDR (nlHsApp pure_Expr)
(map (pats_etc mk_exp) data_cons)
- liftTyped_bind = mkFunBindEC 1 loc liftTyped_RDR (nlHsApp pure_Expr)
+ liftTyped_bind = mkFunBindEC 1 loc liftTyped_RDR (nlHsApp unsafeCodeCoerce_Expr . nlHsApp pure_Expr)
(map (pats_etc mk_texp) data_cons)
mk_exp = ExpBr noExtField
@@ -2352,17 +2352,18 @@ bs_RDRs = [ mkVarUnqual (mkFastString ("b"++show i)) | i <- [(1::Int) ..
cs_RDRs = [ mkVarUnqual (mkFastString ("c"++show i)) | i <- [(1::Int) .. ] ]
a_Expr, b_Expr, c_Expr, z_Expr, ltTag_Expr, eqTag_Expr, gtTag_Expr, false_Expr,
- true_Expr, pure_Expr :: LHsExpr GhcPs
-a_Expr = nlHsVar a_RDR
-b_Expr = nlHsVar b_RDR
-c_Expr = nlHsVar c_RDR
-z_Expr = nlHsVar z_RDR
-ltTag_Expr = nlHsVar ltTag_RDR
-eqTag_Expr = nlHsVar eqTag_RDR
-gtTag_Expr = nlHsVar gtTag_RDR
-false_Expr = nlHsVar false_RDR
-true_Expr = nlHsVar true_RDR
-pure_Expr = nlHsVar pure_RDR
+ true_Expr, pure_Expr, unsafeCodeCoerce_Expr :: LHsExpr GhcPs
+a_Expr = nlHsVar a_RDR
+b_Expr = nlHsVar b_RDR
+c_Expr = nlHsVar c_RDR
+z_Expr = nlHsVar z_RDR
+ltTag_Expr = nlHsVar ltTag_RDR
+eqTag_Expr = nlHsVar eqTag_RDR
+gtTag_Expr = nlHsVar gtTag_RDR
+false_Expr = nlHsVar false_RDR
+true_Expr = nlHsVar true_RDR
+pure_Expr = nlHsVar pure_RDR
+unsafeCodeCoerce_Expr = nlHsVar unsafeCodeCoerce_RDR
a_Pat, b_Pat, c_Pat, d_Pat, k_Pat, z_Pat :: LPat GhcPs
a_Pat = nlVarPat a_RDR
=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -196,7 +196,7 @@ tcTypedBracket rn_expr brack@(TExpBr _ expr) res_ty
; let rep = getRuntimeRep expr_ty
; meta_ty <- tcTExpTy m_var expr_ty
; ps' <- readMutVar ps_ref
- ; texpco <- tcLookupId unsafeTExpCoerceName
+ ; texpco <- tcLookupId unsafeCodeCoerceName
; tcWrapResultO (Shouldn'tHappenOrigin "TExpBr")
rn_expr
(unLoc (mkHsApp (mkLHsWrap (applyQuoteWrapper wrapper)
@@ -302,9 +302,9 @@ tcPendingSplice m_var (PendingRnSplice flavour splice_name expr)
tcTExpTy :: TcType -> TcType -> TcM TcType
tcTExpTy m_ty exp_ty
= do { unless (isTauTy exp_ty) $ addErr (err_msg exp_ty)
- ; texp <- tcLookupTyCon tExpTyConName
+ ; codeCon <- tcLookupTyCon codeTyConName
; let rep = getRuntimeRep exp_ty
- ; return (mkAppTy m_ty (mkTyConApp texp [rep, exp_ty])) }
+ ; return (mkTyConApp codeCon [rep, m_ty, exp_ty]) }
where
err_msg ty
= vcat [ text "Illegal polytype:" <+> ppr ty
@@ -619,10 +619,10 @@ tcNestedSplice pop_stage (TcPending ps_var lie_var q@(QuoteWrapper _ m_var)) spl
; expr' <- setStage pop_stage $
setConstraintVar lie_var $
tcLExpr expr (mkCheckExpType meta_exp_ty)
- ; untypeq <- tcLookupId unTypeQName
+ ; untypeCode <- tcLookupId unTypeCodeName
; let expr'' = mkHsApp
(mkLHsWrap (applyQuoteWrapper q)
- (nlHsTyApp untypeq [rep, res_ty])) expr'
+ (nlHsTyApp untypeCode [rep, res_ty])) expr'
; ps <- readMutVar ps_var
; writeMutVar ps_var (PendingTcSplice splice_name expr'' : ps)
=====================================
docs/users_guide/exts/deriving_extra.rst
=====================================
@@ -528,7 +528,7 @@ Deriving ``Lift`` instances
The class ``Lift``, unlike other derivable classes, lives in
``template-haskell`` instead of ``base``. Having a data type be an instance of
``Lift`` permits its values to be promoted to Template Haskell expressions (of
-type ``ExpQ`` and ``TExpQ a``), which can then be spliced into Haskell source
+type ``ExpQ`` and ``Code Q a``), which can then be spliced into Haskell source
code.
Here is an example of how one can derive ``Lift``:
=====================================
docs/users_guide/exts/template_haskell.rst
=====================================
@@ -133,15 +133,15 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under
is an arbitrary expression.
A top-level typed expression splice can occur in place of an expression; the
- spliced expression must have type ``Q (TExp a)``
+ spliced expression must have type ``Code Q 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
- ``Quote m => m (TExp a)``.
+ ``Quote m => Code m a``.
- Values of type ``TExp a`` may be converted to values of type ``Exp``
- using the function ``unType :: TExp a -> Exp``.
+ It is possible to extract a value of type ``m Exp`` from ``Code m a``
+ using the ``unTypeCode :: Code m a -> m Exp`` function.
- A quasi-quotation can appear in a pattern, type, expression, or
declaration context and is also written in Oxford brackets:
@@ -202,7 +202,7 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under
class Lift t where
lift :: Quote m => t -> m Exp
- liftTyped :: Quote m => t -> m (TExp t)
+ liftTyped :: Quote m => t -> Code m 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
=====================================
libraries/template-haskell/Language/Haskell/TH.hs
=====================================
@@ -50,6 +50,8 @@ module Language.Haskell.TH(
-- * Typed expressions
TExp, unType,
+ Code(..), unTypeCode, unsafeCodeCoerce, hoistCode, bindCode,
+ bindCode_, joinCode, liftCode,
-- * Names
Name, NameSpace, -- Abstract
=====================================
libraries/template-haskell/Language/Haskell/TH/CodeDo.hs
=====================================
@@ -0,0 +1,20 @@
+-- | This module exists to work nicely with the QualifiedDo
+-- extension.
+-- @
+-- import qualified Language.Haskell.TH.CodeDo as Code
+-- myExample :: Monad m => Code m a -> Code m a -> Code m a
+-- myExample opt1 opt2 =
+-- Code.do
+-- x <- someSideEffect -- This one is of type `M Bool`
+-- if x then opt1 else opt2
+-- @
+module Language.Haskell.TH.CodeDo((>>=), (>>)) where
+
+import Language.Haskell.TH.Syntax
+import Prelude(Monad)
+
+-- | Module over monad operator for 'Code'
+(>>=) :: Monad m => m a -> (a -> Code m b) -> Code m b
+(>>=) = bindCode
+(>>) :: Monad m => m a -> Code m b -> Code m b
+(>>) = bindCode_
=====================================
libraries/template-haskell/Language/Haskell/TH/Lib.hs
=====================================
@@ -18,7 +18,7 @@ module Language.Haskell.TH.Lib (
-- * Library functions
-- ** Abbreviations
- InfoQ, ExpQ, TExpQ, DecQ, DecsQ, ConQ, TypeQ, KindQ,
+ InfoQ, ExpQ, TExpQ, CodeQ, DecQ, DecsQ, ConQ, TypeQ, KindQ,
TyLitQ, CxtQ, PredQ, DerivClauseQ, MatchQ, ClauseQ, BodyQ, GuardQ,
StmtQ, RangeQ, SourceStrictnessQ, SourceUnpackednessQ, BangQ,
BangTypeQ, VarBangTypeQ, StrictTypeQ, VarStrictTypeQ, FieldExpQ, PatQ,
=====================================
libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
=====================================
@@ -31,6 +31,7 @@ type PatQ = Q Pat
type FieldPatQ = Q FieldPat
type ExpQ = Q Exp
type TExpQ a = Q (TExp a)
+type CodeQ = Code Q
type DecQ = Q Dec
type DecsQ = Q [Dec]
type Decs = [Dec] -- Defined as it is more convenient to wire-in
=====================================
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
=====================================
@@ -343,6 +343,63 @@ be inferred (#8459). Consider
The splice will evaluate to (MkAge 3) and you can't add that to
4::Int. So you can't coerce a (TExp Age) to a (TExp Int). -}
+-- Code constructor
+
+type role Code representational nominal -- See Note [Role of TExp]
+newtype Code m (a :: TYPE (r :: RuntimeRep)) = Code
+ { examineCode :: m (TExp a) -- ^ Underlying monadic value
+ }
+
+-- | Unsafely convert an untyped code representation into a typed code
+-- representation.
+unsafeCodeCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m .
+ Quote m => m Exp -> Code m a
+unsafeCodeCoerce m = Code (unsafeTExpCoerce m)
+
+-- | Lift a monadic action producing code into the typed 'Code'
+-- representation
+liftCode :: forall (r :: RuntimeRep) (a :: TYPE r) m . m (TExp a) -> Code m a
+liftCode = Code
+
+-- | Extract the untyped representation from the typed representation
+unTypeCode :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m
+ => Code m a -> m Exp
+unTypeCode = unTypeQ . examineCode
+
+-- | Modify the ambient monad used during code generation. For example, you
+-- can use `hoistCode` to handle a state effect:
+-- @
+-- handleState :: Code (StateT Int Q) a -> Code Q a
+-- handleState = hoistCode (flip runState 0)
+-- @
+hoistCode :: forall m n (r :: RuntimeRep) (a :: TYPE r) . Monad m
+ => (forall x . m x -> n x) -> Code m a -> Code n a
+hoistCode f (Code a) = Code (f a)
+
+
+-- | Variant of (>>=) which allows effectful computations to be injected
+-- into code generation.
+bindCode :: forall m a (r :: RuntimeRep) (b :: TYPE r) . Monad m
+ => m a -> (a -> Code m b) -> Code m b
+bindCode q k = liftCode (q >>= examineCode . k)
+
+-- | Variant of (>>) which allows effectful computations to be injected
+-- into code generation.
+bindCode_ :: forall m a (r :: RuntimeRep) (b :: TYPE r) . Monad m
+ => m a -> Code m b -> Code m b
+bindCode_ q c = liftCode ( q >> examineCode c)
+
+-- | A useful combinator for embedding monadic actions into 'Code'
+-- @
+-- myCode :: ... => Code m a
+-- myCode = joinCode $ do
+-- x <- someSideEffect
+-- return (makeCodeWith x)
+-- @
+joinCode :: forall m (r :: RuntimeRep) (a :: TYPE r) . Monad m
+ => m (Code m a) -> Code m a
+joinCode = flip bindCode id
+
----------------------------------------------------
-- Packaged versions for the programmer, hiding the Quasi-ness
@@ -727,107 +784,107 @@ class Lift (t :: TYPE r) where
-- a splice.
lift :: Quote m => t -> m Exp
default lift :: (r ~ 'LiftedRep, Quote m) => t -> m Exp
- lift = unTypeQ . liftTyped
+ lift = unTypeCode . liftTyped
-- | Turn a value into a Template Haskell typed expression, suitable for use
-- in a typed splice.
--
-- @since 2.16.0.0
- liftTyped :: Quote m => t -> m (TExp t)
+ liftTyped :: Quote m => t -> Code m t
-- If you add any instances here, consider updating test th/TH_Lift
instance Lift Integer where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (IntegerL x))
instance Lift Int where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (IntegerL (fromIntegral x)))
-- | @since 2.16.0.0
instance Lift Int# where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (IntPrimL (fromIntegral (I# x))))
instance Lift Int8 where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (IntegerL (fromIntegral x)))
instance Lift Int16 where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (IntegerL (fromIntegral x)))
instance Lift Int32 where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (IntegerL (fromIntegral x)))
instance Lift Int64 where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (IntegerL (fromIntegral x)))
-- | @since 2.16.0.0
instance Lift Word# where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (WordPrimL (fromIntegral (W# x))))
instance Lift Word where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (IntegerL (fromIntegral x)))
instance Lift Word8 where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (IntegerL (fromIntegral x)))
instance Lift Word16 where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (IntegerL (fromIntegral x)))
instance Lift Word32 where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (IntegerL (fromIntegral x)))
instance Lift Word64 where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (IntegerL (fromIntegral x)))
instance Lift Natural where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (IntegerL (fromIntegral x)))
instance Integral a => Lift (Ratio a) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (RationalL (toRational x)))
instance Lift Float where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (RationalL (toRational x)))
-- | @since 2.16.0.0
instance Lift Float# where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (FloatPrimL (toRational (F# x))))
instance Lift Double where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (RationalL (toRational x)))
-- | @since 2.16.0.0
instance Lift Double# where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (DoublePrimL (toRational (D# x))))
instance Lift Char where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (CharL x))
-- | @since 2.16.0.0
instance Lift Char# where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (CharPrimL (C# x)))
instance Lift Bool where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift True = return (ConE trueName)
lift False = return (ConE falseName)
@@ -837,24 +894,24 @@ instance Lift Bool where
--
-- @since 2.16.0.0
instance Lift Addr# where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x
= return (LitE (StringPrimL (map (fromIntegral . ord) (unpackCString# x))))
instance Lift a => Lift (Maybe a) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift Nothing = return (ConE nothingName)
lift (Just x) = liftM (ConE justName `AppE`) (lift x)
instance (Lift a, Lift b) => Lift (Either a b) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift (Left x) = liftM (ConE leftName `AppE`) (lift x)
lift (Right y) = liftM (ConE rightName `AppE`) (lift y)
instance Lift a => Lift [a] where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift xs = do { xs' <- mapM lift xs; return (ListE xs') }
liftString :: Quote m => String -> m Exp
@@ -863,7 +920,7 @@ liftString s = return (LitE (StringL s))
-- | @since 2.15.0.0
instance Lift a => Lift (NonEmpty a) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift (x :| xs) = do
x' <- lift x
@@ -872,77 +929,77 @@ instance Lift a => Lift (NonEmpty a) where
-- | @since 2.15.0.0
instance Lift Void where
- liftTyped = pure . absurd
+ liftTyped = liftCode . absurd
lift = pure . absurd
instance Lift () where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift () = return (ConE (tupleDataName 0))
instance (Lift a, Lift b) => Lift (a, b) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift (a, b)
= liftM TupE $ sequence $ map (fmap Just) [lift a, lift b]
instance (Lift a, Lift b, Lift c) => Lift (a, b, c) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift (a, b, c)
= liftM TupE $ sequence $ map (fmap Just) [lift a, lift b, lift c]
instance (Lift a, Lift b, Lift c, Lift d) => Lift (a, b, c, d) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift (a, b, c, d)
= liftM TupE $ sequence $ map (fmap Just) [lift a, lift b, lift c, lift d]
instance (Lift a, Lift b, Lift c, Lift d, Lift e)
=> Lift (a, b, c, d, e) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift (a, b, c, d, e)
= liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b
, lift c, lift d, lift e ]
instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
=> Lift (a, b, c, d, e, f) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift (a, b, c, d, e, f)
= liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c
, lift d, lift e, lift f ]
instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
=> Lift (a, b, c, d, e, f, g) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift (a, b, c, d, e, f, g)
= liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c
, lift d, lift e, lift f, lift g ]
-- | @since 2.16.0.0
instance Lift (# #) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift (# #) = return (ConE (unboxedTupleTypeName 0))
-- | @since 2.16.0.0
instance (Lift a) => Lift (# a #) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift (# a #)
= liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a]
-- | @since 2.16.0.0
instance (Lift a, Lift b) => Lift (# a, b #) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift (# a, b #)
= liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a, lift b]
-- | @since 2.16.0.0
instance (Lift a, Lift b, Lift c)
=> Lift (# a, b, c #) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift (# a, b, c #)
= liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a, lift b, lift c]
-- | @since 2.16.0.0
instance (Lift a, Lift b, Lift c, Lift d)
=> Lift (# a, b, c, d #) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift (# a, b, c, d #)
= liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b
, lift c, lift d ]
@@ -950,7 +1007,7 @@ instance (Lift a, Lift b, Lift c, Lift d)
-- | @since 2.16.0.0
instance (Lift a, Lift b, Lift c, Lift d, Lift e)
=> Lift (# a, b, c, d, e #) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift (# a, b, c, d, e #)
= liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b
, lift c, lift d, lift e ]
@@ -958,7 +1015,7 @@ instance (Lift a, Lift b, Lift c, Lift d, Lift e)
-- | @since 2.16.0.0
instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
=> Lift (# a, b, c, d, e, f #) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift (# a, b, c, d, e, f #)
= liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c
, lift d, lift e, lift f ]
@@ -966,7 +1023,7 @@ instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
-- | @since 2.16.0.0
instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
=> Lift (# a, b, c, d, e, f, g #) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift (# a, b, c, d, e, f, g #)
= liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c
, lift d, lift e, lift f
@@ -974,7 +1031,7 @@ instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
-- | @since 2.16.0.0
instance (Lift a, Lift b) => Lift (# a | b #) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x
= case x of
(# y | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 2
@@ -983,7 +1040,7 @@ instance (Lift a, Lift b) => Lift (# a | b #) where
-- | @since 2.16.0.0
instance (Lift a, Lift b, Lift c)
=> Lift (# a | b | c #) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x
= case x of
(# y | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 3
@@ -993,7 +1050,7 @@ instance (Lift a, Lift b, Lift c)
-- | @since 2.16.0.0
instance (Lift a, Lift b, Lift c, Lift d)
=> Lift (# a | b | c | d #) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x
= case x of
(# y | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 4
@@ -1004,7 +1061,7 @@ instance (Lift a, Lift b, Lift c, Lift d)
-- | @since 2.16.0.0
instance (Lift a, Lift b, Lift c, Lift d, Lift e)
=> Lift (# a | b | c | d | e #) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x
= case x of
(# y | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 5
@@ -1016,7 +1073,7 @@ instance (Lift a, Lift b, Lift c, Lift d, Lift e)
-- | @since 2.16.0.0
instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
=> Lift (# a | b | c | d | e | f #) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x
= case x of
(# y | | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 6
@@ -1029,7 +1086,7 @@ instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
-- | @since 2.16.0.0
instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
=> Lift (# a | b | c | d | e | f | g #) where
- liftTyped x = unsafeTExpCoerce (lift x)
+ liftTyped x = unsafeCodeCoerce (lift x)
lift x
= case x of
(# y | | | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 7
=====================================
libraries/template-haskell/changelog.md
=====================================
@@ -1,6 +1,9 @@
# Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell)
## 2.17.0.0
+ * Typed Quotations now return a value of type `Code m a` (GHC Proposal #195).
+ The main motiviation is to make writing instances easier and make it easier to
+ store `Code` values in type-indexed maps.
* Implement Overloaded Quotations (GHC Proposal #246). This patch modifies a
few fundamental things in the API. All the library combinators are generalised
@@ -9,7 +12,7 @@
written in terms of `Q` are now disallowed. The types of `unsafeTExpCoerce`
and `unTypeQ` are also generalised in terms of `Quote` rather than specific
to `Q`.
-
+
* Implement Explicit specificity in type variable binders (GHC Proposal #99).
In `Language.Haskell.TH.Syntax`, `TyVarBndr` is now annotated with a `flag`,
denoting the additional argument to its constructors `PlainTV` and `KindedTV`.
=====================================
libraries/template-haskell/template-haskell.cabal.in
=====================================
@@ -48,7 +48,7 @@ Library
Language.Haskell.TH.Quote
Language.Haskell.TH.Syntax
Language.Haskell.TH.LanguageExtensions
-
+ Language.Haskell.TH.CodeDo
Language.Haskell.TH.Lib.Internal
other-modules:
=====================================
libraries/text
=====================================
@@ -1 +1 @@
-Subproject commit a01843250166b5559936ba5eb81f7873e709587a
+Subproject commit 74f835751b60b312d01dd600d516756d5325d514
=====================================
testsuite/tests/quotes/T17857.hs
=====================================
@@ -7,4 +7,4 @@ import Language.Haskell.TH.Syntax
data T = MkT deriving Data
instance Lift T where
lift = liftData
- liftTyped = unsafeTExpCoerce . lift
+ liftTyped = unsafeCodeCoerce . lift
=====================================
testsuite/tests/th/T10945.stderr
=====================================
@@ -1,8 +1,8 @@
T10945.hs:7:4: error:
- • Couldn't match type ‘[Dec]’ with ‘TExp DecsQ’
- Expected type: Q (TExp DecsQ)
- Actual type: Q [Dec]
+ • Couldn't match type ‘[Dec]’ with ‘Q [Dec]’
+ Expected type: Code Q DecsQ
+ Actual type: Code Q [Dec]
• In the expression:
return
[SigD
=====================================
testsuite/tests/th/T15471A.hs
=====================================
@@ -6,9 +6,9 @@ import Language.Haskell.TH
foo1 x = x
-test_foo :: Q (TExp (a -> a))
+test_foo :: Code Q (a -> a)
test_foo = [|| foo1 ||]
-list_foo :: Q (TExp a) -> Q (TExp [a])
+list_foo :: Code Q a -> Code Q [a]
list_foo x = [|| [ $$x, $$x ] ||]
=====================================
testsuite/tests/th/T15843.hs
=====================================
@@ -13,12 +13,12 @@ main = do
mapM_ (\q -> runQ q >>= ppr_and_show)
[first_of_2, second_of_2, empty_2, full_2, third_of_3]
- mapM_ (\q -> runQ (fmap unType q) >>= ppr_and_show)
+ mapM_ (\q -> (runQ (unTypeCode q)) >>= ppr_and_show)
[first_of_2_T, second_of_2_T]
- runQ (fmap unType empty_2_T) >>= ppr_and_show
- runQ (fmap unType full_2_T) >>= ppr_and_show
- runQ (fmap unType third_of_3_T) >>= ppr_and_show
+ runQ (unTypeCode empty_2_T) >>= ppr_and_show
+ runQ (unTypeCode full_2_T) >>= ppr_and_show
+ runQ (unTypeCode third_of_3_T) >>= ppr_and_show
print $ "(909,) applied to 'c' should be (909, 'c') ===> "
++ (show $ (909, 'c') == ($first_of_2 'c'))
=====================================
testsuite/tests/th/T16195A.hs
=====================================
@@ -3,11 +3,11 @@ module T16195A where
import Language.Haskell.TH
-foo :: Q (TExp (IO ()))
+foo :: Code Q (IO ())
foo = [|| return () ||]
-showC :: Q (TExp (() -> String))
+showC :: Code Q (() -> String)
showC = [|| show ||]
-unitC :: Q (TExp ())
+unitC :: Code Q ()
unitC = [|| () ||]
=====================================
testsuite/tests/th/T18121.hs
=====================================
@@ -3,5 +3,5 @@ module Bug where
import Language.Haskell.TH
-sapply :: Q (TExp (a -> b)) -> Q (TExp a) -> Q (TExp b)
+sapply :: Quote m => Code m (a -> b) -> Code m a -> Code m b
sapply cf cx = [|| $$cf $$cx ||]
=====================================
testsuite/tests/th/T8577.stderr
=====================================
@@ -1,8 +1,8 @@
T8577.hs:9:11: error:
• Couldn't match type ‘Int’ with ‘Bool’
- Expected type: Q (TExp (A Bool))
- Actual type: Q (TExp (A Int))
+ Expected type: Code Q (A Bool)
+ Actual type: Code Q (A Int)
• In the expression: y
In the Template Haskell splice $$(y)
In the expression: $$(y)
=====================================
testsuite/tests/th/T8577a.hs
=====================================
@@ -4,8 +4,8 @@ import Language.Haskell.TH
data A a = A
-x :: Q (TExp (A a))
+x :: Code Q (A a)
x = [|| A ||]
-y :: Q (TExp (A Int))
+y :: Code Q (A Int)
y = x
=====================================
testsuite/tests/th/TH_StringLift.hs
=====================================
@@ -3,7 +3,7 @@ module TH_StringLift where
import Language.Haskell.TH.Syntax
-foo :: Quote m => String -> m (TExp String)
+foo :: Quote m => String -> Code m String
foo x = [|| x ||]
foo2 :: Quote m => String -> m Exp
=====================================
testsuite/tests/th/TH_reifyLocalDefs.hs
=====================================
@@ -29,8 +29,8 @@ main = print (f 1 "", g 'a' 2, h True 3)
)
, xg :: Char
)
- h xh y = ( $$(do printTypeOf("xh")
- [|| y :: Int ||]
+ h xh y = ( $$(liftCode $ do printTypeOf("xh")
+ examineCode [|| y :: Int ||]
)
, xh :: Bool
)
=====================================
testsuite/tests/th/overloaded/T17839.hs
=====================================
@@ -16,7 +16,7 @@ import Data.Functor.Identity
type LetT m a = WriterT [Locus] m a
-type Code m a = m (TExp a)
+type MCode m a = m (TExp a)
type LetCode m a = LetT m (TExp a)
@@ -29,7 +29,7 @@ instance (Monoid w, Quote m) => Quote (StateT w m) where
newName x = W.lift (newName x)
-locus :: (Locus -> LetCode m a) -> Code m a
+locus :: (Locus -> LetCode m a) -> MCode m a
locus = undefined
newTypedName :: Quote m => m (TExp a)
@@ -38,15 +38,15 @@ newTypedName = do
return (TExp (VarE n))
-gen :: Quote m => Locus -> (Code Identity (a -> b) -> LetCode m a -> LetCode m b) -> LetCode m (a -> b)
+gen :: Quote m => Locus -> (MCode Identity (a -> b) -> LetCode m a -> LetCode m b) -> LetCode m (a -> b)
gen l f = do
n <- newTypedName
- [|| \a -> $$(f (Identity n) [|| a ||]) ||]
+ examineCode [|| \a -> $$(liftCode $ f (Identity n) (examineCode [|| a ||])) ||]
mrfix :: forall a b m r . (Monad m, Ord a, Quote m)
- => (forall m . (a -> Code m (b -> r)) -> (a -> Code m b -> Code m r))
- -> (a -> Code m (b -> r))
+ => (forall m . (a -> MCode m (b -> r)) -> (a -> MCode m b -> MCode m r))
+ -> (a -> MCode m (b -> r))
mrfix f x =
flip evalStateT Map.empty $
locus $ \locus -> do
=====================================
testsuite/tests/th/overloaded/TH_overloaded_constraints.hs
=====================================
@@ -22,11 +22,11 @@ dq = [| 5 |]
top_level :: (C m, D m, Quote m) => m Exp
top_level = [| $cq + $dq |]
-cqt :: (C m, Quote m) => m (TExp Int)
+cqt :: (C m, Quote m) => Code m Int
cqt = [|| 5 ||]
-dqt :: (D m, Quote m) => m (TExp Int)
+dqt :: (D m, Quote m) => Code m Int
dqt = [|| 5 ||]
-top_level_t :: (C m, D m, Quote m) => m (TExp Int)
+top_level_t :: (C m, D m, Quote m) => Code m Int
top_level_t = [|| $$cqt + $$dqt ||]
=====================================
testsuite/tests/th/overloaded/TH_overloaded_csp.hs
=====================================
@@ -14,5 +14,5 @@ instance Quote Identity where
main = do
print $ runIdentity ((\x -> [| x |]) ())
- print $ unType $ runIdentity ((\x -> [|| x ||]) ())
+ print $ runIdentity $ unTypeCode ((\x -> [|| x ||]) ())
=====================================
testsuite/tests/th/overloaded/TH_overloaded_extract.hs
=====================================
@@ -19,5 +19,5 @@ main = do
print $ runIdentity [d| data Foo = Foo |]
print $ runIdentity [p| () |]
print $ runIdentity [t| [Int] |]
- print $ unType $ runIdentity [|| (+1) ||]
+ print $ runIdentity $ unTypeCode [|| (+1) ||]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74a756df27f5e5ae9b4486bfbabaf1eac2d188f0
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74a756df27f5e5ae9b4486bfbabaf1eac2d188f0
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200527/836454c6/attachment-0001.html>
More information about the ghc-commits
mailing list