summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThomas Winant <thomas.winant@cs.kuleuven.be>2015-07-20 15:43:53 +0200
committerBen Gamari <ben@smart-cactus.org>2015-07-20 16:43:34 +0200
commit49373ffe4cbc87b46468d2372e850138e151a9ae (patch)
treec5b5f74bc06eb924b4d75f10b370a3b3e49a972b
parent82ffc80df573512f788524c4616db3c08fc9f125 (diff)
downloadhaskell-49373ffe4cbc87b46468d2372e850138e151a9ae.tar.gz
Support wild cards in TH splices
- Declaration splices: partial type signatures are fully supported in TH declaration splices. For example, the wild cards in the example below will unify with `Eq a` and `a -> a -> Bool`, as expected: ``` [d| foo :: _ => _ foo x y = x == y |] ``` - Expression splices: anonymous and named wild cards are supported in expression signatures, but extra-constraints wild cards aren't. Just as is the case for regular expression signatures. ``` [e | Just True :: _a _ |] ``` - Typed expression splices: the same wildcards as in (untyped) expression splices are supported. - Pattern splices: TH doesn't support type signatures in pattern splices, consequently, partial type signatures aren't supported either. - Type splices: partial type signatures are only partially supported in type splices, specifically: only anonymous wild cards are allowed. So `[t| _ |]`, `[t| _ -> Maybe _ |]` will work, but `[t| _ => _ |]` or `[| _a |]` won't (without `-XNamedWildCards`, the latter will work as the named wild card is treated as a type variable). Normally, named wild cards are collected before renaming a (partial) type signature. However, TH type splices are run during renaming, i.e. after the initial traversal, leading to out of scope errors for named wild cards. We can't just extend the initial traversal to collect the named wild cards in TH type splices, as we'd need to expand them, which is supposed to happen only once, during renaming. Similarly, the extra-constraints wild card is handled right before renaming too, and is therefore also not supported in a TH type splice. Another reason not to support extra-constraints wild cards in TH type splices is that a single signature can contain many TH type splices, whereas it mustn't contain more than one extra-constraints wild card. Enforcing would this be hard the way things are currently organised. Anonymous wild cards pose no problem, because they start without names and are given names during renaming. These names are collected right after renaming. The names generated for anonymous wild cards in TH type splices will thus be collected as well. With a more invasive refactoring of the renaming, partial type signatures could be fully supported in TH type splices. As only anonymous wild cards have been requested so far, these small changes satisfying this request will do for now. Also don't forget that a TH declaration splices support all kinds of wild cards. - Extra-constraints wild cards were silently ignored in expression and pattern signatures, appropriate error messages are now generated. Test Plan: run new tests Reviewers: austin, goldfire, adamgundry, bgamari Reviewed By: goldfire, adamgundry, bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1048 GHC Trac Issues: #10094, #10548
-rw-r--r--compiler/deSugar/DsMeta.hs35
-rw-r--r--compiler/hsSyn/Convert.hs6
-rw-r--r--compiler/hsSyn/HsTypes.hs9
-rw-r--r--compiler/prelude/THNames.hs44
-rw-r--r--compiler/rename/RnSplice.hs60
-rw-r--r--compiler/rename/RnTypes.hs57
-rw-r--r--docs/users_guide/7.12.1-notes.xml7
-rw-r--r--docs/users_guide/glasgow_exts.xml41
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Lib.hs6
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Ppr.hs1
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Syntax.hs1
-rw-r--r--testsuite/tests/partial-sigs/should_compile/Splices.hs30
-rw-r--r--testsuite/tests/partial-sigs/should_compile/SplicesUsed.hs18
-rw-r--r--testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr73
-rw-r--r--testsuite/tests/partial-sigs/should_compile/TypedSplice.hs9
-rw-r--r--testsuite/tests/partial-sigs/should_compile/TypedSplice.stderr16
-rw-r--r--testsuite/tests/partial-sigs/should_compile/all.T4
-rw-r--r--testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInExpressionSignature.hs3
-rw-r--r--testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInExpressionSignature.stderr6
-rw-r--r--testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSignature.hs4
-rw-r--r--testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSignature.stderr6
-rw-r--r--testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.hs5
-rw-r--r--testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.stderr4
-rw-r--r--testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInTypeSplice.hs7
-rw-r--r--testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInTypeSplice2.hs7
-rw-r--r--testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInTypeSplice2.stderr4
-rw-r--r--testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInTypeSpliceUsed.hs8
-rw-r--r--testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInTypeSpliceUsed.stderr8
-rw-r--r--testsuite/tests/partial-sigs/should_fail/NamedWildcardInTypeSplice.hs8
-rw-r--r--testsuite/tests/partial-sigs/should_fail/NamedWildcardInTypeSplice.stderr5
-rw-r--r--testsuite/tests/partial-sigs/should_fail/WildcardInTypeBrackets.hs4
-rw-r--r--testsuite/tests/partial-sigs/should_fail/WildcardInTypeBrackets.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_fail/all.T12
33 files changed, 451 insertions, 59 deletions
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index b9805ac58b..d9dc02f82b 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -847,11 +847,26 @@ repLTy :: LHsType Name -> DsM (Core TH.TypeQ)
repLTy (L _ ty) = repTy ty
repTy :: HsType Name -> DsM (Core TH.TypeQ)
-repTy (HsForAllTy _ _ tvs ctxt ty) =
+repTy (HsForAllTy _ extra tvs ctxt ty) =
addTyVarBinds tvs $ \bndrs -> do
- ctxt1 <- repLContext ctxt
+ ctxt1 <- repLContext ctxt'
ty1 <- repLTy ty
repTForall bndrs ctxt1 ty1
+ where
+ -- If extra is not Nothing, an extra-constraints wild card was removed
+ -- (just) before renaming. It must be put back now, otherwise the
+ -- represented type won't include this extra-constraints wild card.
+ ctxt'
+ | Just loc <- extra
+ = let uniq = panic "addExtraCtsWC"
+ -- This unique will be discarded by repLContext, but is required
+ -- to make a Name
+ name = mkInternalName uniq (mkTyVarOcc "_") loc
+ in (++ [L loc (HsWildCardTy (AnonWildCard name))]) `fmap` ctxt
+ | otherwise
+ = ctxt
+
+
repTy (HsTyVar n)
| isTvOcc occ = do tv1 <- lookupOcc n
@@ -910,11 +925,10 @@ repTy (HsExplicitTupleTy _ tys) = do
repTy (HsTyLit lit) = do
lit' <- repTyLit lit
repTLit lit'
-repTy (HsWildCardTy wc) = do
- let name = HsSyn.wildCardName wc
- putSrcSpanDs (nameSrcSpan name) $
- failWithDs $ text "Unexpected wild card:" <+>
- quotes (ppr name)
+repTy (HsWildCardTy (AnonWildCard _)) = repTWildCard
+repTy (HsWildCardTy (NamedWildCard n)) = do
+ nwc <- lookupOcc n
+ repTNamedWildCard nwc
repTy ty = notHandled "Exotic form of type" (ppr ty)
@@ -1910,6 +1924,13 @@ repTPromotedList (t:ts) = do { tcon <- repPromotedConsTyCon
repTLit :: Core TH.TyLitQ -> DsM (Core TH.TypeQ)
repTLit (MkC lit) = rep2 litTName [lit]
+repTWildCard :: DsM (Core TH.TypeQ)
+repTWildCard = rep2 wildCardTName []
+
+repTNamedWildCard :: Core TH.Name -> DsM (Core TH.TypeQ)
+repTNamedWildCard (MkC s) = rep2 namedWildCardTName [s]
+
+
--------- Type constructors --------------
repNamedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 4749871eea..7245a1d676 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -1030,6 +1030,12 @@ cvtTypeKind ty_str ty
LitT lit
-> returnL (HsTyLit (cvtTyLit lit))
+ WildCardT Nothing
+ -> mk_apps mkAnonWildCardTy tys'
+
+ WildCardT (Just nm)
+ -> do { nm' <- tName nm; mk_apps (mkNamedWildCardTy nm') tys' }
+
PromotedT nm -> do { nm' <- cName nm; mk_apps (HsTyVar nm') tys' }
-- Promoted data constructor; hence cName
diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs
index 9b8639369c..9526a8cce3 100644
--- a/compiler/hsSyn/HsTypes.hs
+++ b/compiler/hsSyn/HsTypes.hs
@@ -34,7 +34,8 @@ module HsTypes (
ConDeclField(..), LConDeclField, pprConDeclFields,
HsWildCardInfo(..), mkAnonWildCardTy, mkNamedWildCardTy,
- wildCardName, sameWildCard, isAnonWildCard, isNamedWildCard,
+ wildCardName, sameWildCard, sameNamedWildCard,
+ isAnonWildCard, isNamedWildCard,
mkHsQTvs, hsQTvBndrs, isHsKindedTyVar, hsTvbAllKinded,
mkExplicitHsForAllTy, mkImplicitHsForAllTy, mkQualifiedHsForAllTy,
@@ -682,6 +683,12 @@ sameWildCard (L l1 (AnonWildCard _)) (L l2 (AnonWildCard _)) = l1 == l2
sameWildCard (L _ (NamedWildCard n1)) (L _ (NamedWildCard n2)) = n1 == n2
sameWildCard _ _ = False
+sameNamedWildCard :: Eq name
+ => Located (HsWildCardInfo name)
+ -> Located (HsWildCardInfo name) -> Bool
+sameNamedWildCard (L _ (NamedWildCard n1)) (L _ (NamedWildCard n2)) = n1 == n2
+sameNamedWildCard _ _ = False
+
splitHsAppTys :: LHsType n -> [LHsType n] -> (LHsType n, [LHsType n])
splitHsAppTys (L _ (HsAppTy f a)) as = splitHsAppTys f (a:as)
splitHsAppTys (L _ (HsParTy f)) as = splitHsAppTys f as
diff --git a/compiler/prelude/THNames.hs b/compiler/prelude/THNames.hs
index 254431e360..cd65385bb4 100644
--- a/compiler/prelude/THNames.hs
+++ b/compiler/prelude/THNames.hs
@@ -83,6 +83,7 @@ templateHaskellNames = [
forallTName, varTName, conTName, appTName, equalityTName,
tupleTName, unboxedTupleTName, arrowTName, listTName, sigTName, litTName,
promotedTName, promotedTupleTName, promotedNilTName, promotedConsTName,
+ wildCardTName, namedWildCardTName,
-- TyLit
numTyLitName, strTyLitName,
-- TyVarBndr
@@ -359,7 +360,8 @@ varStrictTypeName = libFun (fsLit "varStrictType") varStrictTKey
forallTName, varTName, conTName, tupleTName, unboxedTupleTName, arrowTName,
listTName, appTName, sigTName, equalityTName, litTName,
promotedTName, promotedTupleTName,
- promotedNilTName, promotedConsTName :: Name
+ promotedNilTName, promotedConsTName,
+ wildCardTName, namedWildCardTName :: Name
forallTName = libFun (fsLit "forallT") forallTIdKey
varTName = libFun (fsLit "varT") varTIdKey
conTName = libFun (fsLit "conT") conTIdKey
@@ -375,6 +377,9 @@ promotedTName = libFun (fsLit "promotedT") promotedTIdKey
promotedTupleTName = libFun (fsLit "promotedTupleT") promotedTupleTIdKey
promotedNilTName = libFun (fsLit "promotedNilT") promotedNilTIdKey
promotedConsTName = libFun (fsLit "promotedConsT") promotedConsTIdKey
+wildCardTName = libFun (fsLit "wildCardT") wildCardTIdKey
+namedWildCardTName = libFun (fsLit "namedWildCardT") namedWildCardTIdKey
+
-- data TyLit = ...
numTyLitName, strTyLitName :: Name
@@ -729,7 +734,8 @@ varStrictTKey = mkPreludeMiscIdUnique 375
forallTIdKey, varTIdKey, conTIdKey, tupleTIdKey, unboxedTupleTIdKey, arrowTIdKey,
listTIdKey, appTIdKey, sigTIdKey, equalityTIdKey, litTIdKey,
promotedTIdKey, promotedTupleTIdKey,
- promotedNilTIdKey, promotedConsTIdKey :: Unique
+ promotedNilTIdKey, promotedConsTIdKey,
+ wildCardTIdKey, namedWildCardTIdKey :: Unique
forallTIdKey = mkPreludeMiscIdUnique 380
varTIdKey = mkPreludeMiscIdUnique 381
conTIdKey = mkPreludeMiscIdUnique 382
@@ -745,35 +751,37 @@ promotedTIdKey = mkPreludeMiscIdUnique 391
promotedTupleTIdKey = mkPreludeMiscIdUnique 392
promotedNilTIdKey = mkPreludeMiscIdUnique 393
promotedConsTIdKey = mkPreludeMiscIdUnique 394
+wildCardTIdKey = mkPreludeMiscIdUnique 395
+namedWildCardTIdKey = mkPreludeMiscIdUnique 396
-- data TyLit = ...
numTyLitIdKey, strTyLitIdKey :: Unique
-numTyLitIdKey = mkPreludeMiscIdUnique 395
-strTyLitIdKey = mkPreludeMiscIdUnique 396
+numTyLitIdKey = mkPreludeMiscIdUnique 400
+strTyLitIdKey = mkPreludeMiscIdUnique 401
-- data TyVarBndr = ...
plainTVIdKey, kindedTVIdKey :: Unique
-plainTVIdKey = mkPreludeMiscIdUnique 397
-kindedTVIdKey = mkPreludeMiscIdUnique 398
+plainTVIdKey = mkPreludeMiscIdUnique 402
+kindedTVIdKey = mkPreludeMiscIdUnique 403
-- data Role = ...
nominalRIdKey, representationalRIdKey, phantomRIdKey, inferRIdKey :: Unique
-nominalRIdKey = mkPreludeMiscIdUnique 400
-representationalRIdKey = mkPreludeMiscIdUnique 401
-phantomRIdKey = mkPreludeMiscIdUnique 402
-inferRIdKey = mkPreludeMiscIdUnique 403
+nominalRIdKey = mkPreludeMiscIdUnique 404
+representationalRIdKey = mkPreludeMiscIdUnique 405
+phantomRIdKey = mkPreludeMiscIdUnique 406
+inferRIdKey = mkPreludeMiscIdUnique 407
-- data Kind = ...
varKIdKey, conKIdKey, tupleKIdKey, arrowKIdKey, listKIdKey, appKIdKey,
starKIdKey, constraintKIdKey :: Unique
-varKIdKey = mkPreludeMiscIdUnique 404
-conKIdKey = mkPreludeMiscIdUnique 405
-tupleKIdKey = mkPreludeMiscIdUnique 406
-arrowKIdKey = mkPreludeMiscIdUnique 407
-listKIdKey = mkPreludeMiscIdUnique 408
-appKIdKey = mkPreludeMiscIdUnique 409
-starKIdKey = mkPreludeMiscIdUnique 410
-constraintKIdKey = mkPreludeMiscIdUnique 411
+varKIdKey = mkPreludeMiscIdUnique 408
+conKIdKey = mkPreludeMiscIdUnique 409
+tupleKIdKey = mkPreludeMiscIdUnique 410
+arrowKIdKey = mkPreludeMiscIdUnique 411
+listKIdKey = mkPreludeMiscIdUnique 412
+appKIdKey = mkPreludeMiscIdUnique 413
+starKIdKey = mkPreludeMiscIdUnique 414
+constraintKIdKey = mkPreludeMiscIdUnique 415
-- data Callconv = ...
cCallIdKey, stdCallIdKey, cApiCallIdKey, primCallIdKey,
diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs
index 61b5b14ab4..d023f11ae0 100644
--- a/compiler/rename/RnSplice.hs
+++ b/compiler/rename/RnSplice.hs
@@ -45,6 +45,7 @@ import Hooks
import Var ( Id )
import THNames ( quoteExpName, quotePatName, quoteDecName, quoteTypeName
, decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, )
+import RnTypes ( collectWildCards )
import Util
import {-# SOURCE #-} TcExpr ( tcMonoExpr )
@@ -420,11 +421,70 @@ rnSpliceType splice k
run_type_splice rn_splice
= do { hs_ty2 <- runRnSplice UntypedTypeSplice runMetaT ppr rn_splice
; (hs_ty3, fvs) <- do { let doc = SpliceTypeCtx hs_ty2
+ ; checkValidPartialTypeSplice doc hs_ty2
+ -- See Note [Partial Type Splices]
; checkNoErrs $ rnLHsType doc hs_ty2 }
-- checkNoErrs: see Note [Renamer errors]
; return (HsParTy hs_ty3, fvs) }
-- Wrap the result of the splice in parens so that we don't
-- lose the outermost location set by runQuasiQuote (#7918)
+{-
+Note [Partial Type Splices]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Partial Type Signatures are partially supported in TH type splices: only
+anonymous wild cards are allowed.
+
+Normally, named wild cards are collected before renaming a (partial) type
+signature. However, TH type splices are run during renaming, i.e. after the
+initial traversal, leading to out of scope errors for named wild cards. We
+can't just extend the initial traversal to collect the named wild cards in TH
+type splices, as we'd need to expand them, which is supposed to happen only
+once, during renaming.
+
+Similarly, the extra-constraints wild card is handled right before renaming
+too, and is therefore also not supported in a TH type splice. Another reason
+to forbid extra-constraints wild cards in TH type splices is that a single
+signature can contain many TH type splices, whereas it mustn't contain more
+than one extra-constraints wild card. Enforcing would this be hard the way
+things are currently organised.
+
+Anonymous wild cards pose no problem, because they start out without names and
+are given names during renaming. These names are collected right after
+renaming. The names generated for anonymous wild cards in TH type splices will
+thus be collected as well.
+
+For more details about renaming wild cards, see rnLHsTypeWithWildCards.
+
+Note that partial type signatures are fully supported in TH declaration
+splices, e.g.:
+
+ [d| foo :: _ => _
+ foo x y = x == y |]
+
+This is because in this case, the partial type signature can be treated as a
+whole signature, instead of as an arbitray type.
+
+-}
+
+-- | Check that the type splice doesn't contain an extra-constraint wild card.
+-- See Note [Partial Type Splices]. Named wild cards aren't supported in type
+-- splices either, but they will be caught during renaming, as they won't be
+-- in scope.
+--
+-- Note that without this check, an error would still be reported, but it
+-- would tell the user an unexpected wild card was encountered. This message
+-- is confusing, as it doesn't mention the wild card was unexpected because it
+-- was an extra-constraints wild card. To avoid confusing, this function
+-- provides a specific error message for this case.
+checkValidPartialTypeSplice :: HsDocContext -> LHsType RdrName -> RnM ()
+checkValidPartialTypeSplice doc ty
+ | (L loc _extraWc : _, _) <- collectWildCards ty
+ = failAt loc $ hang (text "Invalid partial type:") 2 (ppr ty) $$
+ text "An extra-constraints wild card is not allowed in a type splice" $$
+ docOfHsDocContext doc
+ | otherwise
+ = return ()
----------------------
-- | Rename a splice pattern. See Note [rnSplicePat]
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index ac2982ba4f..346d764444 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -13,7 +13,7 @@ module RnTypes (
rnHsKind, rnLHsKind, rnLHsMaybeKind,
rnHsSigType, rnLHsInstType, rnConDeclFields,
newTyVarNameRn, rnLHsTypeWithWildCards,
- rnHsSigTypeWithWildCards,
+ rnHsSigTypeWithWildCards, collectWildCards,
-- Precence related stuff
mkOpAppRn, mkNegAppRn, mkOpFormRn, mkConOpPatRn,
@@ -542,7 +542,17 @@ dataKindsErr is_type thing
-- cards to bind.
rnHsSigTypeWithWildCards :: SDoc -> LHsType RdrName
-> RnM (LHsType Name, FreeVars, [Name])
-rnHsSigTypeWithWildCards doc_str = rnLHsTypeWithWildCards (TypeSigCtx doc_str)
+rnHsSigTypeWithWildCards doc_str ty
+ = rnLHsTypeWithWildCards (TypeSigCtx doc_str) ty'
+ where
+ ty' = extractExtraCtsWc `fmap` flattenTopLevelLHsForAllTy ty
+ -- When there is a wild card at the end of the context, remove it and add
+ -- its location as the extra-constraints wild card in the HsForAllTy.
+ extractExtraCtsWc (HsForAllTy flag _ bndrs (L l ctxt) ty)
+ | Just (ctxt', ct) <- snocView ctxt
+ , L lx (HsWildCardTy (AnonWildCard _)) <- ignoreParens ct
+ = HsForAllTy flag (Just lx) bndrs (L l ctxt') ty
+ extractExtraCtsWc ty = ty
-- | Variant of @rnLHsType@ that supports wild cards. The third element of the
-- tuple consists of the freshly generated names of the anonymous wild cards
@@ -551,31 +561,19 @@ rnHsSigTypeWithWildCards doc_str = rnLHsTypeWithWildCards (TypeSigCtx doc_str)
rnLHsTypeWithWildCards :: HsDocContext -> LHsType RdrName
-> RnM (LHsType Name, FreeVars, [Name])
rnLHsTypeWithWildCards doc ty
- = do { -- When there is a wild card at the end of the context, remove it and
- -- add its location as the extra-constraints wild card in the
- -- HsForAllTy.
- let ty' = extractExtraCtsWc `fmap` flattenTopLevelLHsForAllTy ty
-
- ; checkValidPartialType doc ty'
-
+ = do { checkValidPartialType doc ty
; rdr_env <- getLocalRdrEnv
-- Filter out named wildcards that are already in scope
- ; let (_, wcs) = collectWildCards ty'
+ ; let (_, wcs) = collectWildCards ty
nwcs = [L loc n | L loc (NamedWildCard n) <- wcs
, not (elemLocalRdrEnv n rdr_env) ]
; bindLocatedLocalsRn nwcs $ \nwcs' -> do {
- (ty'', fvs) <- rnLHsType doc ty'
+ (ty', fvs) <- rnLHsType doc ty
-- Add the anonymous wildcards that have been given names during
-- renaming
- ; let (_, wcs') = collectWildCards ty''
+ ; let (_, wcs') = collectWildCards ty'
awcs = filter (isAnonWildCard . unLoc) wcs'
- ; return (ty'', fvs, nwcs' ++ map (HsSyn.wildCardName . unLoc) awcs) } }
- where
- extractExtraCtsWc (HsForAllTy flag _ bndrs (L l ctxt) ty)
- | Just (ctxt', ct) <- snocView ctxt
- , L lx (HsWildCardTy (AnonWildCard _)) <- ignoreParens ct
- = HsForAllTy flag (Just lx) bndrs (L l ctxt') ty
- extractExtraCtsWc ty = ty
+ ; return (ty', fvs, nwcs' ++ map (HsSyn.wildCardName . unLoc) awcs) } }
-- | Extract all wild cards from a type. The named and anonymous
-- extra-constraints wild cards are returned separately to be able to give
@@ -584,7 +582,7 @@ collectWildCards
:: Eq name => LHsType name
-> ([Located (HsWildCardInfo name)], -- extra-constraints wild cards
[Located (HsWildCardInfo name)]) -- wild cards
-collectWildCards lty = (nubBy sameWildCard extra, nubBy sameWildCard wcs)
+collectWildCards lty = (extra, nubBy sameNamedWildCard wcs)
where
(extra, wcs) = go lty
go (L loc ty) = case ty of
@@ -648,10 +646,21 @@ checkValidPartialType doc lty
-- If there was a valid extra-constraints wild card, it should have
-- already been removed and its location should be stored in the
-- HsForAllTy
- (if isJust extra
- then text "Only a single extra-constraints wild card is allowed"
- else fcat [ text "An extra-constraints wild card must occur"
- , text "at the end of the constraints" ]) $$
+ (case extra of
+ Just _ ->
+ -- We're in a top-level context with an extracted
+ -- extra-constraints wild card.
+ text "Only a single extra-constraints wild card is allowed"
+ _ | TypeSigCtx _ <- doc ->
+ -- We're in a top-level context, but the extra-constraints wild
+ -- card didn't occur at the end.
+ fcat [ text "An extra-constraints wild card must occur"
+ , text "at the end of the constraints" ]
+ _ ->
+ -- We're not in a top-level context, so no extra-constraints
+ -- wild cards are supported.
+ fcat [ text "An extra-constraints wild card is only allowed"
+ , text "in the top-level context" ]) $$
docOfHsDocContext doc
; whenNonEmpty isAnonWildCard inCtxt $ \(L loc _) ->
diff --git a/docs/users_guide/7.12.1-notes.xml b/docs/users_guide/7.12.1-notes.xml
index cc9dd37dbb..cfe98b530b 100644
--- a/docs/users_guide/7.12.1-notes.xml
+++ b/docs/users_guide/7.12.1-notes.xml
@@ -130,7 +130,12 @@
Splices and quasi-quotes continue to only be supported by a
stage 2 compiler.
</para>
- </listitem>
+ </listitem>
+ <listitem>
+ <para>
+ Partial type signatures can now be used in splices, see <xref linkend="pts-where"/>.
+ </para>
+ </listitem>
</itemizedlist>
</sect3>
diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml
index a9a85fa5ea..2ec1d4e7b5 100644
--- a/docs/users_guide/glasgow_exts.xml
+++ b/docs/users_guide/glasgow_exts.xml
@@ -9397,6 +9397,7 @@ Extra-constraints wildcards cannot be named.
Partial type signatures are allowed for bindings, pattern and expression signatures.
In all other contexts, e.g. type class or type family declarations, they are disallowed.
In the following example a wildcard is used in each of the three possible contexts.
+Extra-constraints wildcards are not supported in pattern or expression signatures.
</para>
<programlisting>
{-# LANGUAGE ScopedTypeVariables #-}
@@ -9404,6 +9405,43 @@ foo :: _
foo (x :: _) = (x :: _)
-- Inferred: forall w_. w_ -> w_
</programlisting>
+
+
+<para>
+Partial type signatures can also be used in <xref linkend="template-haskell"/> splices.
+</para>
+
+<itemizedlist>
+ <listitem>Declaration splices: partial type signature are fully supported.
+<programlisting>
+{-# LANGUAGE TemplateHaskell, NamedWildCards #-}
+$( [d| foo :: _ => _a -> _a -> _
+ foo x y = x == y|] )
+</programlisting>
+ </listitem>
+ <listitem>Expression splices: anonymous and named wildcards can be used in expression signatures.
+ Extra-constraints wildcards are not supported, just like in regular expression signatures.
+<programlisting>
+{-# LANGUAGE TemplateHaskell, NamedWildCards #-}
+$( [e| foo = (Just True :: _m _) |] )
+</programlisting>
+ </listitem>
+ <listitem>Typed expression splices: the same wildcards as in (untyped) expression splices are supported.
+ </listitem>
+ <listitem>Pattern splices: Template Haskell doesn't support type signatures in pattern splices.
+ Consequently, partial type signatures are not supported either.
+ </listitem>
+ <listitem>Type splices: only anonymous wildcards are supported in type splices.
+ Named and extra-constraints wildcards are not.
+<programlisting>
+{-# LANGUAGE TemplateHaskell #-}
+foo :: $( [t| _ |] ) -> a
+foo x = x
+</programlisting>
+ </listitem>
+</itemizedlist>
+
+
</sect2>
</sect1>
<!-- ==================== Deferring type errors ================= -->
@@ -9589,7 +9627,8 @@ Wiki page</ulink>.
the quotation has type <literal>Q Type</literal>.</para></listitem>
<listitem><para> <literal>[p| ... |]</literal>, where the "..." is a pattern;
the quotation has type <literal>Q Pat</literal>.</para></listitem>
- </itemizedlist></para></listitem>
+ </itemizedlist>
+ See <xref linkend="pts-where"/> for using partial type signatures in quotations.</para></listitem>
<listitem>
<para>
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
index d6169042b5..f0431cf36b 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
@@ -548,6 +548,12 @@ sigT t k
equalityT :: TypeQ
equalityT = return EqualityT
+wildCardT :: TypeQ
+wildCardT = return (WildCardT Nothing)
+
+namedWildCardT :: Name -> TypeQ
+namedWildCardT = return . WildCardT . Just
+
{-# DEPRECATED classP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please use 'conT' and 'appT'." #-}
classP :: Name -> [Q Type] -> Q Pred
classP cla tys
diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index 52dcc52a6d..c8f42ef55d 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -500,6 +500,7 @@ pprParendType PromotedConsT = text "(':)"
pprParendType StarT = char '*'
pprParendType ConstraintT = text "Constraint"
pprParendType (SigT ty k) = parens (ppr ty <+> text "::" <+> ppr k)
+pprParendType (WildCardT mbName) = char '_' <> maybe empty ppr mbName
pprParendType other = parens (ppr other)
instance Ppr Type where
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 0ecc32aa07..b1f70f85a0 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -1481,6 +1481,7 @@ data Type = ForallT [TyVarBndr] Cxt Type -- ^ @forall \<vars\>. \<ctxt\> -> \<t
| StarT -- ^ @*@
| ConstraintT -- ^ @Constraint@
| LitT TyLit -- ^ @0,1,2, etc.@
+ | WildCardT (Maybe Name) -- ^ @_, _a, etc.@
deriving( Show, Eq, Ord, Data, Typeable, Generic )
data TyVarBndr = PlainTV Name -- ^ @a@
diff --git a/testsuite/tests/partial-sigs/should_compile/Splices.hs b/testsuite/tests/partial-sigs/should_compile/Splices.hs
new file mode 100644
index 0000000000..9202c18995
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_compile/Splices.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE NamedWildCards #-}
+module Splices where
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Lib (wildCardT)
+
+metaType1 :: TypeQ
+metaType1 = wildCardT
+
+metaType2 :: TypeQ
+metaType2 = [t| _ |]
+
+metaType3 :: TypeQ
+metaType3 = [t| _ -> _ -> _ |]
+
+metaDec1 :: Q [Dec]
+metaDec1 = [d| foo :: _ => _
+ foo x y = x == y |]
+
+metaDec2 :: Q [Dec]
+metaDec2 = [d| bar :: _a -> _b -> (_a, _b)
+ bar x y = (not x, y) |]
+
+-- An expression with a partial type annotation
+metaExp1 :: ExpQ
+metaExp1 = [| Just True :: Maybe _ |]
+
+metaExp2 :: ExpQ
+metaExp2 = [| id :: _a -> _a |]
diff --git a/testsuite/tests/partial-sigs/should_compile/SplicesUsed.hs b/testsuite/tests/partial-sigs/should_compile/SplicesUsed.hs
new file mode 100644
index 0000000000..21e599dcf6
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_compile/SplicesUsed.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+module SplicesUsed where
+
+import Splices
+
+maybeBool :: $(metaType1)
+maybeBool = $(metaExp2) $(metaExp1)
+
+charA :: a -> $(metaType2)
+charA x = ('x', x)
+
+filter' :: $(metaType3)
+filter' = filter
+
+$(metaDec1)
+
+$(metaDec2)
diff --git a/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr b/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr
new file mode 100644
index 0000000000..312cf25217
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr
@@ -0,0 +1,73 @@
+[1 of 2] Compiling Splices ( Splices.hs, Splices.o )
+[2 of 2] Compiling SplicesUsed ( SplicesUsed.hs, SplicesUsed.o )
+
+SplicesUsed.hs:7:16: warning:
+ Found type wildcard ‘_’ standing for ‘Maybe Bool’
+ In the type signature for ‘maybeBool’: _
+
+SplicesUsed.hs:8:15: warning:
+ Found type wildcard ‘_a’ standing for ‘Maybe Bool’
+ Relevant bindings include
+ maybeBool :: Maybe Bool (bound at SplicesUsed.hs:8:1)
+ In an expression type signature: _a -> _a
+ In the expression: id :: _a -> _a
+ In the expression: (id :: _a -> _a) (Just True :: Maybe _)
+
+SplicesUsed.hs:8:27: warning:
+ Found type wildcard ‘_’ standing for ‘Bool’
+ Relevant bindings include
+ maybeBool :: Maybe Bool (bound at SplicesUsed.hs:8:1)
+ In an expression type signature: Maybe _
+ In the first argument of ‘id :: _a -> _a’, namely
+ ‘(Just True :: Maybe _)’
+ In the expression: (id :: _a -> _a) (Just True :: Maybe _)
+
+SplicesUsed.hs:10:17: warning:
+ Found type wildcard ‘_’ standing for ‘(Char, a)’
+ Where: ‘a’ is a rigid type variable bound by
+ the inferred type of charA :: a -> (Char, a)
+ at SplicesUsed.hs:10:10
+ In the type signature for ‘charA’: a -> _
+
+SplicesUsed.hs:13:14: warning:
+ Found type wildcard ‘_’ standing for ‘a -> Bool’
+ Where: ‘a’ is a rigid type variable bound by
+ the inferred type of filter' :: (a -> Bool) -> [a] -> [a]
+ at SplicesUsed.hs:14:1
+ In the type signature for ‘filter'’: _ -> _ -> _
+
+SplicesUsed.hs:13:14: warning:
+ Found type wildcard ‘_’ standing for ‘[a]’
+ Where: ‘a’ is a rigid type variable bound by
+ the inferred type of filter' :: (a -> Bool) -> [a] -> [a]
+ at SplicesUsed.hs:14:1
+ In the type signature for ‘filter'’: _ -> _ -> _
+
+SplicesUsed.hs:13:14: warning:
+ Found type wildcard ‘_’ standing for ‘[a]’
+ Where: ‘a’ is a rigid type variable bound by
+ the inferred type of filter' :: (a -> Bool) -> [a] -> [a]
+ at SplicesUsed.hs:14:1
+ In the type signature for ‘filter'’: _ -> _ -> _
+
+SplicesUsed.hs:16:3: warning:
+ Found hole ‘_’ with inferred constraints: Eq a
+ In the type signature for ‘foo’: _ => _
+
+SplicesUsed.hs:16:3: warning:
+ Found type wildcard ‘_’ standing for ‘a -> a -> Bool’
+ Where: ‘a’ is a rigid type variable bound by
+ the inferred type of foo :: Eq a => a -> a -> Bool
+ at SplicesUsed.hs:16:3
+ In the type signature for ‘foo’: _ => _
+
+SplicesUsed.hs:18:3: warning:
+ Found type wildcard ‘_a’ standing for ‘Bool’
+ In the type signature for ‘bar’: _a -> _b -> (_a, _b)
+
+SplicesUsed.hs:18:3: warning:
+ Found type wildcard ‘_b’ standing for ‘w_b’
+ Where: ‘w_b’ is a rigid type variable bound by
+ the inferred type of bar :: Bool -> w_b -> (Bool, w_b)
+ at SplicesUsed.hs:18:3
+ In the type signature for ‘bar’: _a -> _b -> (_a, _b)
diff --git a/testsuite/tests/partial-sigs/should_compile/TypedSplice.hs b/testsuite/tests/partial-sigs/should_compile/TypedSplice.hs
new file mode 100644
index 0000000000..ef09c4d093
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_compile/TypedSplice.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE NamedWildCards #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+module TypedSplice where
+
+import Language.Haskell.TH
+
+metaExp :: Q (TExp (Bool -> Bool))
+metaExp = [|| not :: _ -> _b ||]
diff --git a/testsuite/tests/partial-sigs/should_compile/TypedSplice.stderr b/testsuite/tests/partial-sigs/should_compile/TypedSplice.stderr
new file mode 100644
index 0000000000..3cfa776ef1
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_compile/TypedSplice.stderr
@@ -0,0 +1,16 @@
+
+TypedSplice.hs:9:22: warning:
+ Found type wildcard ‘_’ standing for ‘Bool’
+ Relevant bindings include
+ metaExp :: Q (TExp (Bool -> Bool)) (bound at TypedSplice.hs:9:1)
+ In an expression type signature: _ -> _b
+ In the Template Haskell quotation [|| not :: _ -> _b ||]
+ In the expression: [|| not :: _ -> _b ||]
+
+TypedSplice.hs:9:27: warning:
+ Found type wildcard ‘_b’ standing for ‘Bool’
+ Relevant bindings include
+ metaExp :: Q (TExp (Bool -> Bool)) (bound at TypedSplice.hs:9:1)
+ In an expression type signature: _ -> _b
+ In the Template Haskell quotation [|| not :: _ -> _b ||]
+ In the expression: [|| not :: _ -> _b ||]
diff --git a/testsuite/tests/partial-sigs/should_compile/all.T b/testsuite/tests/partial-sigs/should_compile/all.T
index c86e14ed38..5597183712 100644
--- a/testsuite/tests/partial-sigs/should_compile/all.T
+++ b/testsuite/tests/partial-sigs/should_compile/all.T
@@ -46,6 +46,10 @@ test('SomethingShowable', normal, compile, ['-ddump-types -fno-warn-partial-type
test('Uncurry', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures'])
test('UncurryNamed', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures'])
test('WarningWildcardInstantiations', normal, compile, ['-ddump-types'])
+test('SplicesUsed', [req_interp, only_compiler_types(['ghc']), when(compiler_profiled(), skip),
+ extra_clean(['Splices.o', 'Splices.hi'])],
+ multimod_compile, ['SplicesUsed', ''])
+test('TypedSplice', [req_interp, normal], compile, [''])
test('T10403', normal, compile, [''])
test('T10438', normal, compile, [''])
test('T10519', normal, compile, [''])
diff --git a/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInExpressionSignature.hs b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInExpressionSignature.hs
new file mode 100644
index 0000000000..8a7ce369e8
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInExpressionSignature.hs
@@ -0,0 +1,3 @@
+module ExtraConstraintsWildcardInExpressionSignature where
+
+foo x y = ((==) :: _ => _) x y
diff --git a/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInExpressionSignature.stderr b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInExpressionSignature.stderr
new file mode 100644
index 0000000000..5432eafc4e
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInExpressionSignature.stderr
@@ -0,0 +1,6 @@
+
+ExtraConstraintsWildcardInExpressionSignature.hs:3:20: error:
+ Invalid partial type: _ => _
+ An extra-constraints wild card is only allowed
+ in the top-level context
+ In an expression type signature
diff --git a/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSignature.hs b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSignature.hs
new file mode 100644
index 0000000000..9fcbf51cbe
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSignature.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module ExtraConstraintsWildcardInPatternSignature where
+
+foo (x :: _ => _) y = x == y
diff --git a/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSignature.stderr b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSignature.stderr
new file mode 100644
index 0000000000..71b3132dc5
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSignature.stderr
@@ -0,0 +1,6 @@
+
+ExtraConstraintsWildcardInPatternSignature.hs:4:11: error:
+ Invalid partial type: _ => _
+ An extra-constraints wild card is only allowed
+ in the top-level context
+ In a pattern type-signature
diff --git a/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.hs b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.hs
new file mode 100644
index 0000000000..1015fd53d1
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module ExtraConstraintsWildcardInPatternSplice where
+
+foo $( [p| (x :: _) |] ) = x
diff --git a/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.stderr b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.stderr
new file mode 100644
index 0000000000..784f437966
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice.stderr
@@ -0,0 +1,4 @@
+
+ExtraConstraintsWildcardInPatternSplice.hs:5:8: error:
+ Type signatures in patterns not (yet) handled by Template Haskell
+ x :: _
diff --git a/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInTypeSplice.hs b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInTypeSplice.hs
new file mode 100644
index 0000000000..c8c54f7819
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInTypeSplice.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+module ExtraConstraintsWildcardInTypeSplice where
+
+import Language.Haskell.TH
+
+metaType :: TypeQ
+metaType = [t| _ => _ |]
diff --git a/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInTypeSplice2.hs b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInTypeSplice2.hs
new file mode 100644
index 0000000000..4f6822c7c4
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInTypeSplice2.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+module ExtraConstraintsWildcardInTypeSplice2 where
+
+import Language.Haskell.TH.Lib (wildCardT)
+
+show' :: $(wildCardT) => a -> String
+show' x = show x
diff --git a/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInTypeSplice2.stderr b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInTypeSplice2.stderr
new file mode 100644
index 0000000000..30efa4d83f
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInTypeSplice2.stderr
@@ -0,0 +1,4 @@
+
+ExtraConstraintsWildcardInTypeSplice2.hs:6:12: error:
+ Unexpected wild card: ‘_’
+ In the type signature for ‘show'’: show' :: (_) => a -> String
diff --git a/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInTypeSpliceUsed.hs b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInTypeSpliceUsed.hs
new file mode 100644
index 0000000000..632f66798f
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInTypeSpliceUsed.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE TemplateHaskell #-}
+module ExtraConstraintsWildcardInTypeSpliceUsed where
+
+import ExtraConstraintsWildcardInTypeSplice
+
+-- An extra-constraints wild card is not supported in type splices
+eq :: $(metaType)
+eq x y = x == y
diff --git a/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInTypeSpliceUsed.stderr b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInTypeSpliceUsed.stderr
new file mode 100644
index 0000000000..c13fe94d89
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_fail/ExtraConstraintsWildcardInTypeSpliceUsed.stderr
@@ -0,0 +1,8 @@
+[1 of 2] Compiling ExtraConstraintsWildcardInTypeSplice ( ExtraConstraintsWildcardInTypeSplice.hs, ExtraConstraintsWildcardInTypeSplice.o )
+[2 of 2] Compiling ExtraConstraintsWildcardInTypeSpliceUsed ( ExtraConstraintsWildcardInTypeSpliceUsed.hs, ExtraConstraintsWildcardInTypeSpliceUsed.o )
+
+ExtraConstraintsWildcardInTypeSpliceUsed.hs:7:9: error:
+ Invalid partial type: _ => _
+ An extra-constraints wild card is not allowed in a type splice
+ In the spliced type _ => _
+ In the untyped splice: $metaType
diff --git a/testsuite/tests/partial-sigs/should_fail/NamedWildcardInTypeSplice.hs b/testsuite/tests/partial-sigs/should_fail/NamedWildcardInTypeSplice.hs
new file mode 100644
index 0000000000..c0c5fcab7c
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_fail/NamedWildcardInTypeSplice.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE NamedWildCards #-}
+module NamedWildcardInTypeSplice where
+
+import Language.Haskell.TH
+
+metaType :: TypeQ
+metaType = [t| _a -> _a |]
diff --git a/testsuite/tests/partial-sigs/should_fail/NamedWildcardInTypeSplice.stderr b/testsuite/tests/partial-sigs/should_fail/NamedWildcardInTypeSplice.stderr
new file mode 100644
index 0000000000..9071531a13
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_fail/NamedWildcardInTypeSplice.stderr
@@ -0,0 +1,5 @@
+
+NamedWildcardInTypeSplice.hs:8:16: error:
+ Unexpected wild card: ‘_a’
+ In a Template-Haskell quoted type
+ In the Template Haskell quotation [t| _a -> _a |]
diff --git a/testsuite/tests/partial-sigs/should_fail/WildcardInTypeBrackets.hs b/testsuite/tests/partial-sigs/should_fail/WildcardInTypeBrackets.hs
deleted file mode 100644
index f11ac5a9f1..0000000000
--- a/testsuite/tests/partial-sigs/should_fail/WildcardInTypeBrackets.hs
+++ /dev/null
@@ -1,4 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-module WildcardInTypeBrackets where
-
-foo = [t| _ |]
diff --git a/testsuite/tests/partial-sigs/should_fail/WildcardInTypeBrackets.stderr b/testsuite/tests/partial-sigs/should_fail/WildcardInTypeBrackets.stderr
deleted file mode 100644
index f72fa7a3aa..0000000000
--- a/testsuite/tests/partial-sigs/should_fail/WildcardInTypeBrackets.stderr
+++ /dev/null
@@ -1,2 +0,0 @@
-
-WildcardInTypeBrackets.hs:4:11: Unexpected wild card: ‘_’
diff --git a/testsuite/tests/partial-sigs/should_fail/all.T b/testsuite/tests/partial-sigs/should_fail/all.T
index 44a35b1cee..9417a3ed8f 100644
--- a/testsuite/tests/partial-sigs/should_fail/all.T
+++ b/testsuite/tests/partial-sigs/should_fail/all.T
@@ -1,6 +1,16 @@
test('AnnotatedConstraint', normal, compile_fail, [''])
test('AnnotatedConstraintNotForgotten', normal, compile_fail, [''])
test('Defaulting1MROff', normal, compile_fail, [''])
+test('ExtraConstraintsWildcardInExpressionSignature', normal, compile_fail, [''])
+test('ExtraConstraintsWildcardInPatternSignature', normal, compile_fail, [''])
+test('ExtraConstraintsWildcardInPatternSplice', normal, compile_fail, [''])
+test('ExtraConstraintsWildcardInTypeSpliceUsed',
+ [req_interp, when(compiler_profiled(), skip),
+ extra_clean(['ExtraConstraintsWildcardInTypeSplice.o', 'ExtraConstraintsWildcardInTypeSplice.hi'])],
+ multimod_compile_fail, ['ExtraConstraintsWildcardInTypeSpliceUsed', ''])
+test('ExtraConstraintsWildcardInTypeSplice2',
+ [req_interp, when(compiler_profiled(), skip)],
+ compile_fail, [''])
test('ExtraConstraintsWildcardNotEnabled', normal, compile_fail, [''])
test('ExtraConstraintsWildcardNotLast', normal, compile_fail, [''])
test('ExtraConstraintsWildcardNotPresent', normal, compile_fail, [''])
@@ -8,6 +18,7 @@ test('ExtraConstraintsWildcardTwice', normal, compile_fail, [''])
test('Forall1Bad', normal, compile_fail, [''])
test('InstantiatedNamedWildcardsInConstraints', normal, compile_fail, [''])
test('NamedExtraConstraintsWildcard', normal, compile_fail, [''])
+test('NamedWildcardInTypeSplice', normal, compile_fail, [''])
test('NamedWildcardsEnabled', normal, compile_fail, [''])
test('NamedWildcardsNotEnabled', normal, compile_fail, [''])
test('NamedWildcardsNotInMonotype', normal, compile_fail, [''])
@@ -42,7 +53,6 @@ test('WildcardInPatSynSig', normal, compile_fail, [''])
test('WildcardInNewtype', normal, compile_fail, [''])
test('WildcardInStandaloneDeriving', normal, compile_fail, [''])
test('WildcardInstantiations', normal, compile_fail, [''])
-test('WildcardInTypeBrackets', req_interp, compile_fail, [''])
test('WildcardInTypeFamilyInstanceLHS', normal, compile_fail, [''])
test('WildcardInTypeFamilyInstanceRHS', normal, compile_fail, [''])
test('WildcardInTypeSynonymLHS', normal, compile_fail, [''])