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
| 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
{- **********************************************************************
%* *
......
......@@ -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
......
......@@ -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
......
......@@ -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`.
......
......@@ -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
......
......@@ -34,6 +34,7 @@ expectedGhcOnlyExtensions = ["RelaxedLayout",
"AlternativeLayoutRule",
"AlternativeLayoutRuleTransitional",
"OverloadedLabels",
"TemplateHaskellQuotes",
"MonadFailDesugaring"]
expectedCabalOnlyExtensions :: [String]
......
{-# LANGUAGE TemplateHaskell, RankNTypes, ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskellQuotes, RankNTypes, ScopedTypeVariables #-}
module A where
x = \(y :: forall a. a -> a) -> [|| y ||]
def f(name, opts):
opts.extra_hc_opts = '-XTemplateHaskell -package template-haskell'
opts.extra_hc_opts = '-XTemplateHaskellQuotes -package template-haskell'
setTestOpts(f)
......
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.
......@@ -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 "++
......
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