diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Rename/Splice.hs | 26 | ||||
| -rw-r--r-- | compiler/parser/Lexer.x | 6 |
2 files changed, 25 insertions, 7 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 |