Commit 85fcd035 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺 Committed by Ben Gamari

Implement new -XTemplateHaskellQuotes pragma

Since f16ddcee / 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
parent 583867b9
...@@ -571,6 +571,7 @@ data ExtensionFlag ...@@ -571,6 +571,7 @@ data ExtensionFlag
| Opt_ParallelArrays -- Syntactic support for parallel arrays | Opt_ParallelArrays -- Syntactic support for parallel arrays
| Opt_Arrows -- Arrow-notation syntax | Opt_Arrows -- Arrow-notation syntax
| Opt_TemplateHaskell | Opt_TemplateHaskell
| Opt_TemplateHaskellQuotes -- subset of TH supported by stage1, no splice
| Opt_QuasiQuotes | Opt_QuasiQuotes
| Opt_ImplicitParams | Opt_ImplicitParams
| Opt_ImplicitPrelude | Opt_ImplicitPrelude
...@@ -3049,7 +3050,7 @@ fLangFlags = [ ...@@ -3049,7 +3050,7 @@ fLangFlags = [
-- See Note [Supporting CLI completion] -- See Note [Supporting CLI completion]
flagSpec' "th" Opt_TemplateHaskell flagSpec' "th" Opt_TemplateHaskell
(\on -> deprecatedForExtension "TemplateHaskell" on (\on -> deprecatedForExtension "TemplateHaskell" on
>> setTemplateHaskellLoc on), >> checkTemplateHaskellOk on),
flagSpec' "fi" Opt_ForeignFunctionInterface flagSpec' "fi" Opt_ForeignFunctionInterface
(deprecatedForExtension "ForeignFunctionInterface"), (deprecatedForExtension "ForeignFunctionInterface"),
flagSpec' "ffi" Opt_ForeignFunctionInterface flagSpec' "ffi" Opt_ForeignFunctionInterface
...@@ -3237,7 +3238,8 @@ xFlags = [ ...@@ -3237,7 +3238,8 @@ xFlags = [
flagSpec "Strict" Opt_Strict, flagSpec "Strict" Opt_Strict,
flagSpec "StrictData" Opt_StrictData, flagSpec "StrictData" Opt_StrictData,
flagSpec' "TemplateHaskell" Opt_TemplateHaskell flagSpec' "TemplateHaskell" Opt_TemplateHaskell
setTemplateHaskellLoc, checkTemplateHaskellOk,
flagSpec "TemplateHaskellQuotes" Opt_TemplateHaskellQuotes,
flagSpec "TraditionalRecordSyntax" Opt_TraditionalRecordSyntax, flagSpec "TraditionalRecordSyntax" Opt_TraditionalRecordSyntax,
flagSpec "TransformListComp" Opt_TransformListComp, flagSpec "TransformListComp" Opt_TransformListComp,
flagSpec "TupleSections" Opt_TupleSections, flagSpec "TupleSections" Opt_TupleSections,
...@@ -3350,6 +3352,8 @@ impliedXFlags ...@@ -3350,6 +3352,8 @@ impliedXFlags
-- Duplicate record fields require field disambiguation -- Duplicate record fields require field disambiguation
, (Opt_DuplicateRecordFields, turnOn, Opt_DisambiguateRecordFields) , (Opt_DuplicateRecordFields, turnOn, Opt_DisambiguateRecordFields)
, (Opt_TemplateHaskell, turnOn, Opt_TemplateHaskellQuotes)
] ]
-- Note [Documenting optimisation flags] -- Note [Documenting optimisation flags]
...@@ -3589,9 +3593,25 @@ setIncoherentInsts True = do ...@@ -3589,9 +3593,25 @@ setIncoherentInsts True = do
l <- getCurLoc l <- getCurLoc
upd (\d -> d { incoherentOnLoc = l }) upd (\d -> d { incoherentOnLoc = l })
setTemplateHaskellLoc :: TurnOnFlag -> DynP () checkTemplateHaskellOk :: TurnOnFlag -> DynP ()
setTemplateHaskellLoc _ #ifdef GHCI
checkTemplateHaskellOk _turn_on
= getCurLoc >>= \l -> upd (\d -> d { thOnLoc = l }) = 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
{- ********************************************************************** {- **********************************************************************
%* * %* *
......
...@@ -369,15 +369,15 @@ $tab { warnTab } ...@@ -369,15 +369,15 @@ $tab { warnTab }
} }
<0> { <0> {
"[|" / { ifExtension thEnabled } { token (ITopenExpQuote NoE) } "[|" / { ifExtension thQuotesEnabled } { token (ITopenExpQuote NoE) }
"[||" / { ifExtension thEnabled } { token (ITopenTExpQuote NoE) } "[||" / { ifExtension thQuotesEnabled } { token (ITopenTExpQuote NoE) }
"[e|" / { ifExtension thEnabled } { token (ITopenExpQuote HasE) } "[e|" / { ifExtension thQuotesEnabled } { token (ITopenExpQuote HasE) }
"[e||" / { ifExtension thEnabled } { token (ITopenTExpQuote HasE) } "[e||" / { ifExtension thQuotesEnabled } { token (ITopenTExpQuote HasE) }
"[p|" / { ifExtension thEnabled } { token ITopenPatQuote } "[p|" / { ifExtension thQuotesEnabled } { token ITopenPatQuote }
"[d|" / { ifExtension thEnabled } { layout_token ITopenDecQuote } "[d|" / { ifExtension thQuotesEnabled } { layout_token ITopenDecQuote }
"[t|" / { ifExtension thEnabled } { token ITopenTypQuote } "[t|" / { ifExtension thQuotesEnabled } { token ITopenTypQuote }
"|]" / { ifExtension thEnabled } { token ITcloseQuote } "|]" / { ifExtension thQuotesEnabled } { token ITcloseQuote }
"||]" / { ifExtension thEnabled } { token ITcloseTExpQuote } "||]" / { ifExtension thQuotesEnabled } { token ITcloseTExpQuote }
\$ @varid / { ifExtension thEnabled } { skip_one_varid ITidEscape } \$ @varid / { ifExtension thEnabled } { skip_one_varid ITidEscape }
"$$" @varid / { ifExtension thEnabled } { skip_two_varid ITidTyEscape } "$$" @varid / { ifExtension thEnabled } { skip_two_varid ITidTyEscape }
"$(" / { ifExtension thEnabled } { token ITparenEscape } "$(" / { ifExtension thEnabled } { token ITparenEscape }
...@@ -2002,6 +2002,7 @@ data ExtBits ...@@ -2002,6 +2002,7 @@ data ExtBits
| ParrBit | ParrBit
| ArrowsBit | ArrowsBit
| ThBit | ThBit
| ThQuotesBit
| IpBit | IpBit
| OverloadedLabelsBit -- #x overloaded labels | OverloadedLabelsBit -- #x overloaded labels
| ExplicitForallBit -- the 'forall' keyword and '.' symbol | ExplicitForallBit -- the 'forall' keyword and '.' symbol
...@@ -2041,6 +2042,8 @@ arrowsEnabled :: ExtsBitmap -> Bool ...@@ -2041,6 +2042,8 @@ arrowsEnabled :: ExtsBitmap -> Bool
arrowsEnabled = xtest ArrowsBit arrowsEnabled = xtest ArrowsBit
thEnabled :: ExtsBitmap -> Bool thEnabled :: ExtsBitmap -> Bool
thEnabled = xtest ThBit thEnabled = xtest ThBit
thQuotesEnabled :: ExtsBitmap -> Bool
thQuotesEnabled = xtest ThQuotesBit
ipEnabled :: ExtsBitmap -> Bool ipEnabled :: ExtsBitmap -> Bool
ipEnabled = xtest IpBit ipEnabled = xtest IpBit
overloadedLabelsEnabled :: ExtsBitmap -> Bool overloadedLabelsEnabled :: ExtsBitmap -> Bool
...@@ -2133,6 +2136,7 @@ mkPState flags buf loc = ...@@ -2133,6 +2136,7 @@ mkPState flags buf loc =
.|. ParrBit `setBitIf` xopt Opt_ParallelArrays flags .|. ParrBit `setBitIf` xopt Opt_ParallelArrays flags
.|. ArrowsBit `setBitIf` xopt Opt_Arrows flags .|. ArrowsBit `setBitIf` xopt Opt_Arrows flags
.|. ThBit `setBitIf` xopt Opt_TemplateHaskell flags .|. ThBit `setBitIf` xopt Opt_TemplateHaskell flags
.|. ThQuotesBit `setBitIf` xopt Opt_TemplateHaskellQuotes flags
.|. QqBit `setBitIf` xopt Opt_QuasiQuotes flags .|. QqBit `setBitIf` xopt Opt_QuasiQuotes flags
.|. IpBit `setBitIf` xopt Opt_ImplicitParams flags .|. IpBit `setBitIf` xopt Opt_ImplicitParams flags
.|. OverloadedLabelsBit `setBitIf` xopt Opt_OverloadedLabels flags .|. OverloadedLabelsBit `setBitIf` xopt Opt_OverloadedLabels flags
......
...@@ -63,12 +63,13 @@ import {-# SOURCE #-} TcSplice ( runMetaD, runMetaE, runMetaP, runMetaT, tcTopSp ...@@ -63,12 +63,13 @@ import {-# SOURCE #-} TcSplice ( runMetaD, runMetaE, runMetaP, runMetaT, tcTopSp
rnBracket :: HsExpr RdrName -> HsBracket RdrName -> RnM (HsExpr Name, FreeVars) rnBracket :: HsExpr RdrName -> HsBracket RdrName -> RnM (HsExpr Name, FreeVars)
rnBracket e br_body rnBracket e br_body
= addErrCtxt (quotationCtxtDoc br_body) $ = addErrCtxt (quotationCtxtDoc br_body) $
do { -- Check that Template Haskell is enabled and available do { -- Check that -XTemplateHaskellQuotes is enabled and available
thEnabled <- xoptM Opt_TemplateHaskell thQuotesEnabled <- xoptM Opt_TemplateHaskellQuotes
; unless thEnabled $ ; unless thQuotesEnabled $
failWith ( vcat failWith ( vcat
[ text "Syntax error on" <+> ppr e [ 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 -- Check for nested brackets
; cur_stage <- getStage ; cur_stage <- getStage
......
...@@ -185,11 +185,11 @@ GHCi ...@@ -185,11 +185,11 @@ GHCi
Template Haskell Template Haskell
~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~
- The ``TemplateHaskell`` now no longer automatically errors when used - The new ``-XTemplateHaskellQuotes`` flag allows to use the
with a stage 1 compiler (i.e. GHC without interpreter support); in quotes (not quasi-quotes) subset of ``TemplateHaskell``. This is
particular, plain Haskell quotes (not quasi-quotes) can now be particularly useful for use with a stage 1 compiler (i.e. GHC
compiled without erroring. Splices and quasi-quotes continue to only without interpreter support). Also, ``-XTemplateHaskellQuotes`` is
be supported by a stage 2 compiler. considered safe under Safe Haskell.
- Partial type signatures can now be used in splices, see - Partial type signatures can now be used in splices, see
:ref:`pts-where`. :ref:`pts-where`.
......
...@@ -9489,10 +9489,15 @@ Syntax ...@@ -9489,10 +9489,15 @@ Syntax
.. index:: .. index::
single: -XTemplateHaskell single: -XTemplateHaskell
single: -XTemplateHaskellQuotes
Template Haskell has the following new syntactic constructions. You need
to use the flag ``-XTemplateHaskell`` to switch these syntactic extensions Template Haskell has the following new syntactic constructions. You
on. 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 - A splice is written ``$x``, where ``x`` is an identifier, or
``$(...)``, where the "..." is an arbitrary expression. There must be ``$(...)``, where the "..." is an arbitrary expression. There must be
......
...@@ -34,6 +34,7 @@ expectedGhcOnlyExtensions = ["RelaxedLayout", ...@@ -34,6 +34,7 @@ expectedGhcOnlyExtensions = ["RelaxedLayout",
"AlternativeLayoutRule", "AlternativeLayoutRule",
"AlternativeLayoutRuleTransitional", "AlternativeLayoutRuleTransitional",
"OverloadedLabels", "OverloadedLabels",
"TemplateHaskellQuotes",
"MonadFailDesugaring"] "MonadFailDesugaring"]
expectedCabalOnlyExtensions :: [String] expectedCabalOnlyExtensions :: [String]
......
{-# LANGUAGE TemplateHaskell, RankNTypes, ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskellQuotes, RankNTypes, ScopedTypeVariables #-}
module A where module A where
x = \(y :: forall a. a -> a) -> [|| y ||] x = \(y :: forall a. a -> a) -> [|| y ||]
def f(name, opts): def f(name, opts):
opts.extra_hc_opts = '-XTemplateHaskell -package template-haskell' opts.extra_hc_opts = '-XTemplateHaskellQuotes -package template-haskell'
setTestOpts(f) setTestOpts(f)
......
SafeLang12.hs:2:14: Warning: SafeLang12.hs:2:14: warning:
-XTemplateHaskell is not allowed in Safe Haskell; ignoring -XTemplateHaskell -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 -XTemplateHaskell is not allowed in Safe Haskell; ignoring -XTemplateHaskell
[1 of 3] Compiling SafeLang12_B ( SafeLang12_B.hs, SafeLang12_B.o ) [1 of 3] Compiling SafeLang12_B ( SafeLang12_B.hs, SafeLang12_B.o )
SafeLang12_B.hs:14:67: SafeLang12_B.hs:5:1: error:
Syntax error on ''Class Language.Haskell.TH: Can't be safely imported!
Perhaps you intended to use TemplateHaskell The module itself isn't safe.
In the Template Haskell quotation ''Class
...@@ -642,6 +642,13 @@ languageOptions = ...@@ -642,6 +642,13 @@ languageOptions =
, flagReverse = "-XNoTemplateHaskell" , flagReverse = "-XNoTemplateHaskell"
, flagSince = "6.8.1" , 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" , flag { flagName = "-XNoTraditionalRecordSyntax"
, flagDescription = , flagDescription =
"Disable support for traditional record syntax "++ "Disable support for traditional record syntax "++
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment