diff options
author | Herbert Valerio Riedel <hvr@gnu.org> | 2015-11-27 13:39:18 +0100 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2015-11-29 13:22:14 +0100 |
commit | 85fcd035f73679927a0539d5f6c9b919517365e1 (patch) | |
tree | a7876675987aba3fa0262b003852599b79daaf05 | |
parent | 583867b907ddac8c2777e96a5ad8d600ba559569 (diff) | |
download | haskell-85fcd035f73679927a0539d5f6c9b919517365e1.tar.gz |
Implement new -XTemplateHaskellQuotes pragma
Since f16ddcee0c64a92ab911a7841a8cf64e3ac671fd / D876, `ghc-stage1`
supports a subset of `-XTemplateHaskell`, but since we need Cabal to be
able detect (so `.cabal` files can be specified accordingly, see also
GHC #11102 which omits `TemplateHaskell` from `--supported-extensions`)
whether GHC provides full or only partial `-XTemplateHaskell` support,
the proper way to accomplish this is to split off the
quotation/non-splicing `TemplateHaskell` feature-subset into a new
language pragma `TemplateHaskellQuotes`.
Moreover, `-XTemplateHaskellQuotes` is considered safe under SafeHaskell
This addresses #11121
Reviewers: goldfire, ezyang, dterei, austin, bgamari
Reviewed By: bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D1511
GHC Trac Issues: #11121
-rw-r--r-- | compiler/main/DynFlags.hs | 28 | ||||
-rw-r--r-- | compiler/parser/Lexer.x | 22 | ||||
-rw-r--r-- | compiler/rename/RnSplice.hs | 9 | ||||
-rw-r--r-- | docs/users_guide/7.12.1-notes.rst | 10 | ||||
-rw-r--r-- | docs/users_guide/glasgow_exts.rst | 13 | ||||
-rw-r--r-- | testsuite/tests/driver/T4437.hs | 1 | ||||
-rw-r--r-- | testsuite/tests/quotes/T10384.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/quotes/all.T | 2 | ||||
-rw-r--r-- | testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr | 11 | ||||
-rw-r--r-- | utils/mkUserGuidePart/Options/Language.hs | 7 |
10 files changed, 71 insertions, 34 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index e005be25cb..ac27243aa3 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -571,6 +571,7 @@ data ExtensionFlag | Opt_ParallelArrays -- Syntactic support for parallel arrays | Opt_Arrows -- Arrow-notation syntax | Opt_TemplateHaskell + | Opt_TemplateHaskellQuotes -- subset of TH supported by stage1, no splice | Opt_QuasiQuotes | Opt_ImplicitParams | Opt_ImplicitPrelude @@ -3049,7 +3050,7 @@ fLangFlags = [ -- See Note [Supporting CLI completion] flagSpec' "th" Opt_TemplateHaskell (\on -> deprecatedForExtension "TemplateHaskell" on - >> setTemplateHaskellLoc on), + >> checkTemplateHaskellOk on), flagSpec' "fi" Opt_ForeignFunctionInterface (deprecatedForExtension "ForeignFunctionInterface"), flagSpec' "ffi" Opt_ForeignFunctionInterface @@ -3237,7 +3238,8 @@ xFlags = [ flagSpec "Strict" Opt_Strict, flagSpec "StrictData" Opt_StrictData, flagSpec' "TemplateHaskell" Opt_TemplateHaskell - setTemplateHaskellLoc, + checkTemplateHaskellOk, + flagSpec "TemplateHaskellQuotes" Opt_TemplateHaskellQuotes, flagSpec "TraditionalRecordSyntax" Opt_TraditionalRecordSyntax, flagSpec "TransformListComp" Opt_TransformListComp, flagSpec "TupleSections" Opt_TupleSections, @@ -3350,6 +3352,8 @@ impliedXFlags -- Duplicate record fields require field disambiguation , (Opt_DuplicateRecordFields, turnOn, Opt_DisambiguateRecordFields) + + , (Opt_TemplateHaskell, turnOn, Opt_TemplateHaskellQuotes) ] -- Note [Documenting optimisation flags] @@ -3589,9 +3593,25 @@ setIncoherentInsts True = do l <- getCurLoc upd (\d -> d { incoherentOnLoc = l }) -setTemplateHaskellLoc :: TurnOnFlag -> DynP () -setTemplateHaskellLoc _ +checkTemplateHaskellOk :: TurnOnFlag -> DynP () +#ifdef GHCI +checkTemplateHaskellOk _turn_on = getCurLoc >>= \l -> upd (\d -> d { thOnLoc = l }) +#else +-- In stage 1, Template Haskell is simply illegal, except with -M +-- We don't bleat with -M because there's no problem with TH there, +-- and in fact GHC's build system does ghc -M of the DPH libraries +-- with a stage1 compiler +checkTemplateHaskellOk turn_on + | turn_on = do dfs <- liftEwM getCmdLineState + case ghcMode dfs of + MkDepend -> return () + _ -> addErr msg + | otherwise = return () + where + msg = "Template Haskell requires GHC with interpreter support\n " ++ + "Perhaps you are using a stage-1 compiler?" +#endif {- ********************************************************************** %* * diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index da9424d5bc..9e57b4be36 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -369,15 +369,15 @@ $tab { warnTab } } <0> { - "[|" / { ifExtension thEnabled } { token (ITopenExpQuote NoE) } - "[||" / { ifExtension thEnabled } { token (ITopenTExpQuote NoE) } - "[e|" / { ifExtension thEnabled } { token (ITopenExpQuote HasE) } - "[e||" / { ifExtension thEnabled } { token (ITopenTExpQuote HasE) } - "[p|" / { ifExtension thEnabled } { token ITopenPatQuote } - "[d|" / { ifExtension thEnabled } { layout_token ITopenDecQuote } - "[t|" / { ifExtension thEnabled } { token ITopenTypQuote } - "|]" / { ifExtension thEnabled } { token ITcloseQuote } - "||]" / { ifExtension thEnabled } { token ITcloseTExpQuote } + "[|" / { ifExtension thQuotesEnabled } { token (ITopenExpQuote NoE) } + "[||" / { ifExtension thQuotesEnabled } { token (ITopenTExpQuote NoE) } + "[e|" / { ifExtension thQuotesEnabled } { token (ITopenExpQuote HasE) } + "[e||" / { ifExtension thQuotesEnabled } { token (ITopenTExpQuote HasE) } + "[p|" / { ifExtension thQuotesEnabled } { token ITopenPatQuote } + "[d|" / { ifExtension thQuotesEnabled } { layout_token ITopenDecQuote } + "[t|" / { ifExtension thQuotesEnabled } { token ITopenTypQuote } + "|]" / { ifExtension thQuotesEnabled } { token ITcloseQuote } + "||]" / { ifExtension thQuotesEnabled } { token ITcloseTExpQuote } \$ @varid / { ifExtension thEnabled } { skip_one_varid ITidEscape } "$$" @varid / { ifExtension thEnabled } { skip_two_varid ITidTyEscape } "$(" / { ifExtension thEnabled } { token ITparenEscape } @@ -2002,6 +2002,7 @@ data ExtBits | ParrBit | ArrowsBit | ThBit + | ThQuotesBit | IpBit | OverloadedLabelsBit -- #x overloaded labels | ExplicitForallBit -- the 'forall' keyword and '.' symbol @@ -2041,6 +2042,8 @@ arrowsEnabled :: ExtsBitmap -> Bool arrowsEnabled = xtest ArrowsBit thEnabled :: ExtsBitmap -> Bool thEnabled = xtest ThBit +thQuotesEnabled :: ExtsBitmap -> Bool +thQuotesEnabled = xtest ThQuotesBit ipEnabled :: ExtsBitmap -> Bool ipEnabled = xtest IpBit overloadedLabelsEnabled :: ExtsBitmap -> Bool @@ -2133,6 +2136,7 @@ mkPState flags buf loc = .|. ParrBit `setBitIf` xopt Opt_ParallelArrays flags .|. ArrowsBit `setBitIf` xopt Opt_Arrows flags .|. ThBit `setBitIf` xopt Opt_TemplateHaskell flags + .|. ThQuotesBit `setBitIf` xopt Opt_TemplateHaskellQuotes flags .|. QqBit `setBitIf` xopt Opt_QuasiQuotes flags .|. IpBit `setBitIf` xopt Opt_ImplicitParams flags .|. OverloadedLabelsBit `setBitIf` xopt Opt_OverloadedLabels flags diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs index 8d570ea3b7..95c54625a5 100644 --- a/compiler/rename/RnSplice.hs +++ b/compiler/rename/RnSplice.hs @@ -63,12 +63,13 @@ import {-# SOURCE #-} TcSplice ( runMetaD, runMetaE, runMetaP, runMetaT, tcTopSp rnBracket :: HsExpr RdrName -> HsBracket RdrName -> RnM (HsExpr Name, FreeVars) rnBracket e br_body = addErrCtxt (quotationCtxtDoc br_body) $ - do { -- Check that Template Haskell is enabled and available - thEnabled <- xoptM Opt_TemplateHaskell - ; unless thEnabled $ + do { -- Check that -XTemplateHaskellQuotes is enabled and available + thQuotesEnabled <- xoptM Opt_TemplateHaskellQuotes + ; unless thQuotesEnabled $ failWith ( vcat [ text "Syntax error on" <+> ppr e - , text "Perhaps you intended to use TemplateHaskell" ] ) + , text ("Perhaps you intended to use TemplateHaskell" + ++ " or TemplateHaskellQuotes") ] ) -- Check for nested brackets ; cur_stage <- getStage diff --git a/docs/users_guide/7.12.1-notes.rst b/docs/users_guide/7.12.1-notes.rst index 6fac019879..dfc5bb361b 100644 --- a/docs/users_guide/7.12.1-notes.rst +++ b/docs/users_guide/7.12.1-notes.rst @@ -185,11 +185,11 @@ GHCi Template Haskell ~~~~~~~~~~~~~~~~ -- The ``TemplateHaskell`` now no longer automatically errors when used - with a stage 1 compiler (i.e. GHC without interpreter support); in - particular, plain Haskell quotes (not quasi-quotes) can now be - compiled without erroring. Splices and quasi-quotes continue to only - be supported by a stage 2 compiler. +- The new ``-XTemplateHaskellQuotes`` flag allows to use the + quotes (not quasi-quotes) subset of ``TemplateHaskell``. This is + particularly useful for use with a stage 1 compiler (i.e. GHC + without interpreter support). Also, ``-XTemplateHaskellQuotes`` is + considered safe under Safe Haskell. - Partial type signatures can now be used in splices, see :ref:`pts-where`. diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst index 424d4b68d1..11cebb17d7 100644 --- a/docs/users_guide/glasgow_exts.rst +++ b/docs/users_guide/glasgow_exts.rst @@ -9489,10 +9489,15 @@ Syntax .. index:: single: -XTemplateHaskell - -Template Haskell has the following new syntactic constructions. You need -to use the flag ``-XTemplateHaskell`` to switch these syntactic extensions -on. + single: -XTemplateHaskellQuotes + +Template Haskell has the following new syntactic constructions. You +need to use the flag ``-XTemplateHaskell`` to switch these syntactic +extensions on. Alternatively, the ``-XTemplateHaskellQuotes`` flag can +be used to enable the quotation subset of Template Haskell +(i.e. without splice syntax). The ``-XTemplateHaskellQuotes`` +extension is considered safe under :ref:`safe-haskell` while +``-XTemplateHaskell`` is not. - A splice is written ``$x``, where ``x`` is an identifier, or ``$(...)``, where the "..." is an arbitrary expression. There must be diff --git a/testsuite/tests/driver/T4437.hs b/testsuite/tests/driver/T4437.hs index 5c087311cc..f58d4c4b8a 100644 --- a/testsuite/tests/driver/T4437.hs +++ b/testsuite/tests/driver/T4437.hs @@ -34,6 +34,7 @@ expectedGhcOnlyExtensions = ["RelaxedLayout", "AlternativeLayoutRule", "AlternativeLayoutRuleTransitional", "OverloadedLabels", + "TemplateHaskellQuotes", "MonadFailDesugaring"] expectedCabalOnlyExtensions :: [String] diff --git a/testsuite/tests/quotes/T10384.hs b/testsuite/tests/quotes/T10384.hs index 773deb061a..c4d9c70ffe 100644 --- a/testsuite/tests/quotes/T10384.hs +++ b/testsuite/tests/quotes/T10384.hs @@ -1,3 +1,3 @@ -{-# LANGUAGE TemplateHaskell, RankNTypes, ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskellQuotes, RankNTypes, ScopedTypeVariables #-} module A where x = \(y :: forall a. a -> a) -> [|| y ||] diff --git a/testsuite/tests/quotes/all.T b/testsuite/tests/quotes/all.T index a56a50c010..c34a207292 100644 --- a/testsuite/tests/quotes/all.T +++ b/testsuite/tests/quotes/all.T @@ -1,5 +1,5 @@ def f(name, opts): - opts.extra_hc_opts = '-XTemplateHaskell -package template-haskell' + opts.extra_hc_opts = '-XTemplateHaskellQuotes -package template-haskell' setTestOpts(f) diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr index 79ff65c2e9..066b56c4bb 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr @@ -1,12 +1,11 @@ -SafeLang12.hs:2:14: Warning: +SafeLang12.hs:2:14: warning: -XTemplateHaskell is not allowed in Safe Haskell; ignoring -XTemplateHaskell -SafeLang12_B.hs:2:14: Warning: +SafeLang12_B.hs:2:14: warning: -XTemplateHaskell is not allowed in Safe Haskell; ignoring -XTemplateHaskell [1 of 3] Compiling SafeLang12_B ( SafeLang12_B.hs, SafeLang12_B.o ) -SafeLang12_B.hs:14:67: - Syntax error on ''Class - Perhaps you intended to use TemplateHaskell - In the Template Haskell quotation ''Class +SafeLang12_B.hs:5:1: error: + Language.Haskell.TH: Can't be safely imported! + The module itself isn't safe. diff --git a/utils/mkUserGuidePart/Options/Language.hs b/utils/mkUserGuidePart/Options/Language.hs index 17416ffbf1..ab3e20f40c 100644 --- a/utils/mkUserGuidePart/Options/Language.hs +++ b/utils/mkUserGuidePart/Options/Language.hs @@ -642,6 +642,13 @@ languageOptions = , flagReverse = "-XNoTemplateHaskell" , flagSince = "6.8.1" } + , flag { flagName = "-XTemplateHaskellQuotes" + , flagDescription = "Enable quotation subset of "++ + ":ref:`Template Haskell <template-haskell>`." + , flagType = DynamicFlag + , flagReverse = "-XNoTemplateHaskellQuotes" + , flagSince = "8.0.1" + } , flag { flagName = "-XNoTraditionalRecordSyntax" , flagDescription = "Disable support for traditional record syntax "++ |