diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2019-12-06 17:11:46 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-02-11 18:04:17 -0500 |
commit | 82023524ff050f26bf00be3432a97f1e537caf41 (patch) | |
tree | 27357f3a71baec1bbe8dab1c59ca82e370b3ca44 | |
parent | 58a4ddeff7730d160dd66f19c288f8b5b27679e3 (diff) | |
download | haskell-82023524ff050f26bf00be3432a97f1e537caf41.tar.gz |
TemplateHaskellQuotes: Allow nested splices
There is no issue with nested splices as they do not require any compile
time code execution. All execution is delayed until the top-level
splice.
-rw-r--r-- | compiler/GHC/Rename/Splice.hs | 26 | ||||
-rw-r--r-- | compiler/parser/Lexer.x | 6 | ||||
-rw-r--r-- | docs/users_guide/8.12.1-notes.rst | 3 | ||||
-rw-r--r-- | docs/users_guide/exts/template_haskell.rst | 2 | ||||
-rw-r--r-- | testsuite/tests/quotes/TH_double_splice.hs | 7 | ||||
-rw-r--r-- | testsuite/tests/quotes/TH_double_splice.stderr | 7 | ||||
-rw-r--r-- | testsuite/tests/quotes/TH_nested_splice.hs | 11 | ||||
-rw-r--r-- | testsuite/tests/quotes/TH_top_splice.hs | 7 | ||||
-rw-r--r-- | testsuite/tests/quotes/TH_top_splice.stderr | 4 | ||||
-rw-r--r-- | testsuite/tests/quotes/TTH_top_splice.hs | 8 | ||||
-rw-r--r-- | testsuite/tests/quotes/TTH_top_splice.stderr | 4 | ||||
-rw-r--r-- | testsuite/tests/quotes/all.T | 4 | ||||
-rw-r--r-- | testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr | 5 |
13 files changed, 83 insertions, 11 deletions
diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs index 5115052718..3f746ee39c 100644 --- a/compiler/GHC/Rename/Splice.hs +++ b/compiler/GHC/Rename/Splice.hs @@ -270,9 +270,10 @@ rnSpliceGen run_splice pend_splice splice ; writeMutVar ps_var (pending_splice : ps) ; return (result, fvs) } - _ -> do { (splice', fvs1) <- checkNoErrs $ - setStage (Splice splice_type) $ - rnSplice splice + _ -> do { checkTopSpliceAllowed splice + ; (splice', fvs1) <- checkNoErrs $ + setStage (Splice splice_type) $ + rnSplice splice -- checkNoErrs: don't attempt to run the splice if -- renaming it failed; otherwise we get a cascade of -- errors from e.g. unbound variables @@ -284,6 +285,22 @@ rnSpliceGen run_splice pend_splice splice then Typed else Untyped + +-- Nested splices are fine without TemplateHaskell because they +-- are not executed until the top-level splice is run. +checkTopSpliceAllowed :: HsSplice GhcPs -> RnM () +checkTopSpliceAllowed splice = do + let (herald, ext) = spliceExtension splice + extEnabled <- xoptM ext + unless extEnabled + (failWith $ text herald <+> text "are not permitted without" <+> ppr ext) + where + spliceExtension :: HsSplice GhcPs -> (String, LangExt.Extension) + spliceExtension (HsQuasiQuote {}) = ("Quasi-quotes", LangExt.QuasiQuotes) + spliceExtension (HsTypedSplice {}) = ("Top-level splices", LangExt.TemplateHaskell) + spliceExtension (HsUntypedSplice {}) = ("Top-level splices", LangExt.TemplateHaskell) + spliceExtension s = pprPanic "spliceExtension" (ppr s) + ------------------ -- | Returns the result of running a splice and the modFinalizers collected @@ -644,7 +661,8 @@ rnSpliceDecl (XSpliceDecl nec) = noExtCon nec rnTopSpliceDecls :: HsSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeVars) -- Declaration splice at the very top level of the module rnTopSpliceDecls splice - = do { (rn_splice, fvs) <- checkNoErrs $ + = do { checkTopSpliceAllowed splice + ; (rn_splice, fvs) <- checkNoErrs $ setStage (Splice Untyped) $ rnSplice splice -- As always, be sure to checkNoErrs above lest we end up with diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 5e7270be01..98c422bd4d 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -1450,9 +1450,9 @@ varsym_prefix :: Action varsym_prefix = sym $ \exts s -> if | TypeApplicationsBit `xtest` exts, s == fsLit "@" -> return ITtypeApp - | ThBit `xtest` exts, s == fsLit "$" + | ThQuotesBit `xtest` exts, s == fsLit "$" -> return ITdollar - | ThBit `xtest` exts, s == fsLit "$$" + | ThQuotesBit `xtest` exts, s == fsLit "$$" -> return ITdollardollar | s == fsLit "!" -> return ITbang | s == fsLit "~" -> return ITtilde @@ -2786,7 +2786,7 @@ srcParseErr options buf len last100 = decodePrevNChars 100 buf doInLast100 = "do" `isInfixOf` last100 mdoInLast100 = "mdo" `isInfixOf` last100 - th_enabled = ThBit `xtest` pExtsBitmap options + th_enabled = ThQuotesBit `xtest` pExtsBitmap options ps_enabled = PatternSynonymsBit `xtest` pExtsBitmap options -- Report a parse failure, giving the span of the previous token as diff --git a/docs/users_guide/8.12.1-notes.rst b/docs/users_guide/8.12.1-notes.rst index 8f2c26041e..b1db851d56 100644 --- a/docs/users_guide/8.12.1-notes.rst +++ b/docs/users_guide/8.12.1-notes.rst @@ -46,6 +46,9 @@ Template Haskell ``where`` bindings properly. Previously, such fixity declarations would be dropped when quoted due to a Template Haskell bug. + - The ``-XTemplateHaskellQuotes`` extension now allows nested splices as nested + splices do not lead directly to compile-time evaluation. (!2288) + ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ diff --git a/docs/users_guide/exts/template_haskell.rst b/docs/users_guide/exts/template_haskell.rst index b7e0e4dff2..7998ceda86 100644 --- a/docs/users_guide/exts/template_haskell.rst +++ b/docs/users_guide/exts/template_haskell.rst @@ -48,7 +48,7 @@ Syntax Template Haskell has the following new syntactic constructions. You need to use the extension :extension:`TemplateHaskell` to switch these syntactic extensions on. Alternatively, the :extension:`TemplateHaskellQuotes` extension can be used to -enable the quotation subset of Template Haskell (i.e. without splice syntax). +enable the quotation subset of Template Haskell (i.e. without top-level splices). The :extension:`TemplateHaskellQuotes` extension is considered safe under :ref:`safe-haskell` while :extension:`TemplateHaskell` is not. diff --git a/testsuite/tests/quotes/TH_double_splice.hs b/testsuite/tests/quotes/TH_double_splice.hs new file mode 100644 index 0000000000..d8a0faeeae --- /dev/null +++ b/testsuite/tests/quotes/TH_double_splice.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskellQuotes #-} +module TH_double_splice where + +-- Should be a compile time error as TemplateHaskell is not enabled. + +foo = [| $($(error "should not happen")) |] + diff --git a/testsuite/tests/quotes/TH_double_splice.stderr b/testsuite/tests/quotes/TH_double_splice.stderr new file mode 100644 index 0000000000..34cb933a1d --- /dev/null +++ b/testsuite/tests/quotes/TH_double_splice.stderr @@ -0,0 +1,7 @@ + +TH_double_splice.hs:6:12: error: + • Top-level splices are not permitted without TemplateHaskell + • In the untyped splice: $(error "should not happen") + In the untyped splice: $($(error "should not happen")) + In the Template Haskell quotation + [| $($(error "should not happen")) |] diff --git a/testsuite/tests/quotes/TH_nested_splice.hs b/testsuite/tests/quotes/TH_nested_splice.hs new file mode 100644 index 0000000000..811aa5e426 --- /dev/null +++ b/testsuite/tests/quotes/TH_nested_splice.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskellQuotes #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +module TH_nested_splice where + +a = [| 5 |] + +b = [| $(a) |] + +c = [|| 5 ||] + +d = [|| $$(c) ||] diff --git a/testsuite/tests/quotes/TH_top_splice.hs b/testsuite/tests/quotes/TH_top_splice.hs new file mode 100644 index 0000000000..a7092bfd9d --- /dev/null +++ b/testsuite/tests/quotes/TH_top_splice.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskellQuotes #-} +module TH_top_splice where + +-- Should be a compile time error as TemplateHaskell is not enabled. + +foo = $([| 1 |]) + diff --git a/testsuite/tests/quotes/TH_top_splice.stderr b/testsuite/tests/quotes/TH_top_splice.stderr new file mode 100644 index 0000000000..8ca30c2426 --- /dev/null +++ b/testsuite/tests/quotes/TH_top_splice.stderr @@ -0,0 +1,4 @@ + +TH_top_splice.hs:6:7: error: + • Top-level splices are not permitted without TemplateHaskell + • In the untyped splice: $([| 1 |]) diff --git a/testsuite/tests/quotes/TTH_top_splice.hs b/testsuite/tests/quotes/TTH_top_splice.hs new file mode 100644 index 0000000000..53b85434de --- /dev/null +++ b/testsuite/tests/quotes/TTH_top_splice.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TemplateHaskellQuotes #-} +module TTH_top_splice where + +-- Should be a compile time error as TemplateHaskell is not enabled. + +qux = $$([|| 1 ||]) + + diff --git a/testsuite/tests/quotes/TTH_top_splice.stderr b/testsuite/tests/quotes/TTH_top_splice.stderr new file mode 100644 index 0000000000..ef659c21d8 --- /dev/null +++ b/testsuite/tests/quotes/TTH_top_splice.stderr @@ -0,0 +1,4 @@ + +TTH_top_splice.hs:6:7: error: + • Top-level splices are not permitted without TemplateHaskell + • In the typed splice: $$([|| 1 ||]) diff --git a/testsuite/tests/quotes/all.T b/testsuite/tests/quotes/all.T index a10da1046f..46f53bce6a 100644 --- a/testsuite/tests/quotes/all.T +++ b/testsuite/tests/quotes/all.T @@ -30,3 +30,7 @@ test('TH_repE3', normal, compile, ['']) test('TH_abstractFamily', normal, compile_fail, ['']) test('TH_localname', normal, compile_fail, ['']) test('TH_typed_csp', normal, compile, ['']) +test('TH_nested_splice', normal, compile, ['']) +test('TH_top_splice', normal, compile_fail, ['']) +test('TTH_top_splice', normal, compile_fail, ['']) +test('TH_double_splice', normal, compile_fail, ['']) diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr index 55aa3a5a6c..c7923a0403 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr @@ -8,6 +8,5 @@ SafeLang12_B.hs:2:14: warning: [2 of 3] Compiling SafeLang12_B ( SafeLang12_B.hs, SafeLang12_B.o ) [3 of 3] Compiling Main ( SafeLang12.hs, SafeLang12.o ) -SafeLang12.hs:8:1: error: - parse error on input ‘$’ - Perhaps you intended to use TemplateHaskell +SafeLang12.hs:1:1: error: + Top-level splices are not permitted without TemplateHaskell |