summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/deSugar/DsMeta.hs6
-rw-r--r--compiler/hsSyn/Convert.hs3
-rw-r--r--compiler/prelude/THNames.hs62
-rw-r--r--docs/users_guide/8.2.1-notes.rst2
-rw-r--r--libraries/template-haskell/Language/Haskell/TH.hs2
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Lib.hs3
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Ppr.hs2
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Syntax.hs1
-rw-r--r--libraries/template-haskell/changelog.md2
-rw-r--r--testsuite/tests/th/T12530.hs15
-rw-r--r--testsuite/tests/th/T12530.stderr10
-rw-r--r--testsuite/tests/th/all.T1
12 files changed, 78 insertions, 31 deletions
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 4dd0789e23..638d9b468b 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -1124,6 +1124,9 @@ repE (HsLamCase (MG { mg_alts = L _ ms }))
; core_ms <- coreList matchQTyConName ms'
; repLamCase core_ms }
repE (HsApp x y) = do {a <- repLE x; b <- repLE y; repApp a b}
+repE (HsAppType e t) = do { a <- repLE e
+ ; s <- repLTy (hswc_body t)
+ ; repAppType a s }
repE (OpApp e1 op _ e2) =
do { arg1 <- repLE e1;
@@ -1853,6 +1856,9 @@ repLit (MkC c) = rep2 litEName [c]
repApp :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
repApp (MkC x) (MkC y) = rep2 appEName [x,y]
+repAppType :: Core TH.ExpQ -> Core TH.TypeQ -> DsM (Core TH.ExpQ)
+repAppType (MkC x) (MkC y) = rep2 appTypeEName [x,y]
+
repLam :: Core [TH.PatQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
repLam (MkC ps) (MkC e) = rep2 lamEName [ps, e]
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index c29db585a7..5b5119a404 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -756,6 +756,9 @@ cvtl e = wrapL (cvt e)
; return $ HsApp (mkLHsPar x') y' }
cvt (AppE x y) = do { x' <- cvtl x; y' <- cvtl y
; return $ HsApp x' y' }
+ cvt (AppTypeE e t) = do { e' <- cvtl e
+ ; t' <- cvtType t
+ ; return $ HsAppType e' $ mkHsWildCardBndrs t' }
cvt (LamE ps e) = do { ps' <- cvtPats ps; e' <- cvtl e
; return $ HsLam (mkMatchGroup FromSource
[mkSimpleMatch LambdaExpr ps' e'])}
diff --git a/compiler/prelude/THNames.hs b/compiler/prelude/THNames.hs
index 9ae54332d5..4f98114bb5 100644
--- a/compiler/prelude/THNames.hs
+++ b/compiler/prelude/THNames.hs
@@ -48,7 +48,7 @@ templateHaskellNames = [
-- Clause
clauseName,
-- Exp
- varEName, conEName, litEName, appEName, infixEName,
+ varEName, conEName, litEName, appEName, appTypeEName, infixEName,
infixAppName, sectionLName, sectionRName, lamEName, lamCaseEName,
tupEName, unboxedTupEName, unboxedSumEName,
condEName, multiIfEName, letEName, caseEName, doEName, compEName,
@@ -269,7 +269,7 @@ clauseName :: Name
clauseName = libFun (fsLit "clause") clauseIdKey
-- data Exp = ...
-varEName, conEName, litEName, appEName, infixEName, infixAppName,
+varEName, conEName, litEName, appEName, appTypeEName, infixEName, infixAppName,
sectionLName, sectionRName, lamEName, lamCaseEName, tupEName,
unboxedTupEName, unboxedSumEName, condEName, multiIfEName, letEName,
caseEName, doEName, compEName, staticEName, unboundVarEName :: Name
@@ -277,6 +277,7 @@ varEName = libFun (fsLit "varE") varEIdKey
conEName = libFun (fsLit "conE") conEIdKey
litEName = libFun (fsLit "litE") litEIdKey
appEName = libFun (fsLit "appE") appEIdKey
+appTypeEName = libFun (fsLit "appTypeE") appTypeEIdKey
infixEName = libFun (fsLit "infixE") infixEIdKey
infixAppName = libFun (fsLit "infixApp") infixAppIdKey
sectionLName = libFun (fsLit "sectionL") sectionLIdKey
@@ -764,9 +765,9 @@ clauseIdKey = mkPreludeMiscIdUnique 262
-- data Exp = ...
-varEIdKey, conEIdKey, litEIdKey, appEIdKey, infixEIdKey, infixAppIdKey,
- sectionLIdKey, sectionRIdKey, lamEIdKey, lamCaseEIdKey, tupEIdKey,
- unboxedTupEIdKey, unboxedSumEIdKey, condEIdKey, multiIfEIdKey,
+varEIdKey, conEIdKey, litEIdKey, appEIdKey, appTypeEIdKey, infixEIdKey,
+ infixAppIdKey, sectionLIdKey, sectionRIdKey, lamEIdKey, lamCaseEIdKey,
+ tupEIdKey, unboxedTupEIdKey, unboxedSumEIdKey, condEIdKey, multiIfEIdKey,
letEIdKey, caseEIdKey, doEIdKey, compEIdKey,
fromEIdKey, fromThenEIdKey, fromToEIdKey, fromThenToEIdKey,
listEIdKey, sigEIdKey, recConEIdKey, recUpdEIdKey, staticEIdKey,
@@ -775,31 +776,32 @@ varEIdKey = mkPreludeMiscIdUnique 270
conEIdKey = mkPreludeMiscIdUnique 271
litEIdKey = mkPreludeMiscIdUnique 272
appEIdKey = mkPreludeMiscIdUnique 273
-infixEIdKey = mkPreludeMiscIdUnique 274
-infixAppIdKey = mkPreludeMiscIdUnique 275
-sectionLIdKey = mkPreludeMiscIdUnique 276
-sectionRIdKey = mkPreludeMiscIdUnique 277
-lamEIdKey = mkPreludeMiscIdUnique 278
-lamCaseEIdKey = mkPreludeMiscIdUnique 279
-tupEIdKey = mkPreludeMiscIdUnique 280
-unboxedTupEIdKey = mkPreludeMiscIdUnique 281
-unboxedSumEIdKey = mkPreludeMiscIdUnique 282
-condEIdKey = mkPreludeMiscIdUnique 283
-multiIfEIdKey = mkPreludeMiscIdUnique 284
-letEIdKey = mkPreludeMiscIdUnique 285
-caseEIdKey = mkPreludeMiscIdUnique 286
-doEIdKey = mkPreludeMiscIdUnique 287
-compEIdKey = mkPreludeMiscIdUnique 288
-fromEIdKey = mkPreludeMiscIdUnique 289
-fromThenEIdKey = mkPreludeMiscIdUnique 290
-fromToEIdKey = mkPreludeMiscIdUnique 291
-fromThenToEIdKey = mkPreludeMiscIdUnique 292
-listEIdKey = mkPreludeMiscIdUnique 293
-sigEIdKey = mkPreludeMiscIdUnique 294
-recConEIdKey = mkPreludeMiscIdUnique 295
-recUpdEIdKey = mkPreludeMiscIdUnique 296
-staticEIdKey = mkPreludeMiscIdUnique 297
-unboundVarEIdKey = mkPreludeMiscIdUnique 298
+appTypeEIdKey = mkPreludeMiscIdUnique 274
+infixEIdKey = mkPreludeMiscIdUnique 275
+infixAppIdKey = mkPreludeMiscIdUnique 276
+sectionLIdKey = mkPreludeMiscIdUnique 277
+sectionRIdKey = mkPreludeMiscIdUnique 278
+lamEIdKey = mkPreludeMiscIdUnique 279
+lamCaseEIdKey = mkPreludeMiscIdUnique 280
+tupEIdKey = mkPreludeMiscIdUnique 281
+unboxedTupEIdKey = mkPreludeMiscIdUnique 282
+unboxedSumEIdKey = mkPreludeMiscIdUnique 283
+condEIdKey = mkPreludeMiscIdUnique 284
+multiIfEIdKey = mkPreludeMiscIdUnique 285
+letEIdKey = mkPreludeMiscIdUnique 286
+caseEIdKey = mkPreludeMiscIdUnique 287
+doEIdKey = mkPreludeMiscIdUnique 288
+compEIdKey = mkPreludeMiscIdUnique 289
+fromEIdKey = mkPreludeMiscIdUnique 290
+fromThenEIdKey = mkPreludeMiscIdUnique 291
+fromToEIdKey = mkPreludeMiscIdUnique 292
+fromThenToEIdKey = mkPreludeMiscIdUnique 293
+listEIdKey = mkPreludeMiscIdUnique 294
+sigEIdKey = mkPreludeMiscIdUnique 295
+recConEIdKey = mkPreludeMiscIdUnique 296
+recUpdEIdKey = mkPreludeMiscIdUnique 297
+staticEIdKey = mkPreludeMiscIdUnique 298
+unboundVarEIdKey = mkPreludeMiscIdUnique 299
-- type FieldExp = ...
fieldExpIdKey :: Unique
diff --git a/docs/users_guide/8.2.1-notes.rst b/docs/users_guide/8.2.1-notes.rst
index f0b931e356..c50990f1b2 100644
--- a/docs/users_guide/8.2.1-notes.rst
+++ b/docs/users_guide/8.2.1-notes.rst
@@ -215,6 +215,8 @@ template-haskell
- Added support for unboxed sums :ghc-ticket:`12478`.
+- Added support for visible type applications :ghc-ticket:`12530`.
+
time
~~~~
diff --git a/libraries/template-haskell/Language/Haskell/TH.hs b/libraries/template-haskell/Language/Haskell/TH.hs
index 984bbc6b4f..7cf342a460 100644
--- a/libraries/template-haskell/Language/Haskell/TH.hs
+++ b/libraries/template-haskell/Language/Haskell/TH.hs
@@ -105,7 +105,7 @@ module Language.Haskell.TH(
normalB, guardedB, normalG, normalGE, patG, patGE, match, clause,
-- *** Expressions
- dyn, varE, conE, litE, appE, uInfixE, parensE, staticE,
+ dyn, varE, conE, litE, appE, appTypeE, uInfixE, parensE, staticE,
infixE, infixApp, sectionL, sectionR,
lamE, lam1E, lamCaseE, tupE, unboxedSumE, condE, multiIfE, letE, caseE,
appsE, listE, sigE, recConE, recUpdE, stringE, fieldExp,
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
index 503f6ea84f..2631c0e32d 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
@@ -232,6 +232,9 @@ litE c = return (LitE c)
appE :: ExpQ -> ExpQ -> ExpQ
appE x y = do { a <- x; b <- y; return (AppE a b)}
+appTypeE :: ExpQ -> TypeQ -> ExpQ
+appTypeE x t = do { a <- x; s <- t; return (AppTypeE a s) }
+
parensE :: ExpQ -> ExpQ
parensE x = do { x' <- x; return (ParensE x') }
diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index 49d0e7b0d8..bdd4dd388a 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -131,6 +131,8 @@ pprExp _ (ConE c) = pprName' Applied c
pprExp i (LitE l) = pprLit i l
pprExp i (AppE e1 e2) = parensIf (i >= appPrec) $ pprExp opPrec e1
<+> pprExp appPrec e2
+pprExp i (AppTypeE e t)
+ = parensIf (i >= appPrec) $ pprExp opPrec e <+> char '@' <> pprParendType t
pprExp _ (ParensE e) = parens (pprExp noPrec e)
pprExp i (UInfixE e1 op e2)
= parensIf (i > unopPrec) $ pprExp unopPrec e1
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 8539e79bd2..73955becce 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -1445,6 +1445,7 @@ data Exp
| ConE Name -- ^ @data T1 = C1 t1 t2; p = {C1} e1 e2 @
| LitE Lit -- ^ @{ 5 or \'c\'}@
| AppE Exp Exp -- ^ @{ f x }@
+ | AppTypeE Exp Type -- $ @{ f \@Int }
| InfixE (Maybe Exp) Exp (Maybe Exp) -- ^ @{x + y} or {(x+)} or {(+ x)} or {(+)}@
diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md
index d6f0d46c02..e23fbf7db1 100644
--- a/libraries/template-haskell/changelog.md
+++ b/libraries/template-haskell/changelog.md
@@ -10,6 +10,8 @@
* Add support for unboxed sums. (#12478)
+ * Add support for visible type applications. (#12530)
+
## 2.11.0.0 *May 2016*
* Bundled with GHC 8.0.1
diff --git a/testsuite/tests/th/T12530.hs b/testsuite/tests/th/T12530.hs
new file mode 100644
index 0000000000..4c0e27dcbf
--- /dev/null
+++ b/testsuite/tests/th/T12530.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+module T12530 where
+
+import Language.Haskell.TH
+
+$([d| -- Test the Template Haskell pretty-printing for TypeApplications
+ f :: Maybe Int -> Maybe Int
+ f = id @(Maybe Int)
+
+ -- Wildcards and scoped type variables too
+ g :: forall a. a
+ g = undefined @(_) @(a)
+ |])
diff --git a/testsuite/tests/th/T12530.stderr b/testsuite/tests/th/T12530.stderr
new file mode 100644
index 0000000000..0ba15360ac
--- /dev/null
+++ b/testsuite/tests/th/T12530.stderr
@@ -0,0 +1,10 @@
+T12530.hs:(8,3)-(15,6): Splicing declarations
+ [d| f :: Maybe Int -> Maybe Int
+ f = id @(Maybe Int)
+ g :: forall a. a
+ g = undefined @(_) @(a) |]
+ ======>
+ f :: Maybe Int -> Maybe Int
+ f = id @(Maybe Int)
+ g :: forall a. a
+ g = undefined @_ @a
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 592e133e7d..2cfe2a509b 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -427,3 +427,4 @@ test('T12478_2', omit_ways(['ghci']), compile_and_run, ['-v0'])
test('T12478_3', omit_ways(['ghci']), compile, ['-v0'])
test('T12478_4', omit_ways(['ghci']), compile_fail, ['-v0'])
test('T12513', omit_ways(['ghci']), compile_fail, ['-v0'])
+test('T12530', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
View Lorry Controller Status