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.

1 files changed, 22 insertions, 4 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