Remove dead code
[ghc.git] / compiler / rename / RnSplice.hs
index 61b5b14..5766080 100644 (file)
@@ -1,55 +1,66 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module RnSplice (
         rnTopSpliceDecls,
         rnSpliceType, rnSpliceExpr, rnSplicePat, rnSpliceDecl,
         rnBracket,
         checkThLocalName
-#ifdef GHCI
         , traceSplice, SpliceInfo(..)
-#endif
   ) where
 
 #include "HsVersions.h"
 
+import GhcPrelude
+
 import Name
 import NameSet
 import HsSyn
 import RdrName
 import TcRnMonad
-import Kind
 
 import RnEnv
+import RnUtils          ( HsDocContext(..), newLocalBndrRn )
+import RnUnbound        ( isUnboundName )
 import RnSource         ( rnSrcDecls, findSplice )
 import RnPat            ( rnPat )
-import BasicTypes       ( TopLevelFlag, isTopLevel )
+import BasicTypes       ( TopLevelFlag, isTopLevel, SourceText(..) )
 import Outputable
 import Module
 import SrcLoc
-import DynFlags
-import FastString
 import RnTypes          ( rnLHsType )
 
 import Control.Monad    ( unless, when )
 
 import {-# SOURCE #-} RnExpr   ( rnLExpr )
 
-import PrelNames        ( isUnboundName )
 import TcEnv            ( checkWellStaged )
 import THNames          ( liftName )
 
-#ifdef GHCI
+import DynFlags
+import FastString
 import ErrUtils         ( dumpIfSet_dyn_printer )
 import TcEnv            ( tcMetaTy )
 import Hooks
-import Var              ( Id )
 import THNames          ( quoteExpName, quotePatName, quoteDecName, quoteTypeName
                         , decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, )
-import Util
 
-import {-# SOURCE #-} TcExpr   ( tcMonoExpr )
-import {-# SOURCE #-} TcSplice ( runMetaD, runMetaE, runMetaP, runMetaT, tcTopSpliceExpr )
-#endif
+import {-# SOURCE #-} TcExpr   ( tcPolyExpr )
+import {-# SOURCE #-} TcSplice
+    ( runMetaD
+    , runMetaE
+    , runMetaP
+    , runMetaT
+    , tcTopSpliceExpr
+    )
+
+import TcHsSyn
+
+import GHCi.RemoteTypes ( ForeignRef )
+import qualified Language.Haskell.TH as TH (Q)
+
+import qualified GHC.LanguageExtensions as LangExt
 
 {-
 ************************************************************************
@@ -59,41 +70,53 @@ import {-# SOURCE #-} TcSplice ( runMetaD, runMetaE, runMetaP, runMetaT, tcTopSp
 ************************************************************************
 -}
 
-rnBracket :: HsExpr RdrName -> HsBracket RdrName -> RnM (HsExpr Name, FreeVars)
+rnBracket :: HsExpr GhcPs -> HsBracket GhcPs -> RnM (HsExpr GhcRn, FreeVars)
 rnBracket e br_body
   = addErrCtxt (quotationCtxtDoc br_body) $
-    do { -- Check that Template Haskell is enabled and available
-         thEnabled <- xoptM Opt_TemplateHaskell
-       ; unless thEnabled $
-           failWith ( vcat [ ptext (sLit "Syntax error on") <+> ppr e
-                           , ptext (sLit "Perhaps you intended to use TemplateHaskell") ] )
+    do { -- Check that -XTemplateHaskellQuotes is enabled and available
+         thQuotesEnabled <- xoptM LangExt.TemplateHaskellQuotes
+       ; unless thQuotesEnabled $
+           failWith ( vcat
+                      [ text "Syntax error on" <+> ppr e
+                      , text ("Perhaps you intended to use TemplateHaskell"
+                              ++ " or TemplateHaskellQuotes") ] )
 
          -- Check for nested brackets
        ; cur_stage <- getStage
        ; case cur_stage of
-           { Splice True  -> checkTc (isTypedBracket br_body) illegalUntypedBracket
-           ; Splice False -> checkTc (not (isTypedBracket br_body)) illegalTypedBracket
-           ; Comp         -> return ()
-           ; Brack {}     -> failWithTc illegalBracket
+           { Splice Typed   -> checkTc (isTypedBracket br_body)
+                                       illegalUntypedBracket
+           ; Splice Untyped -> checkTc (not (isTypedBracket br_body))
+                                       illegalTypedBracket
+           ; RunSplice _    ->
+               -- See Note [RunSplice ThLevel] in "TcRnTypes".
+               pprPanic "rnBracket: Renaming bracket when running a splice"
+                        (ppr e)
+           ; Comp           -> return ()
+           ; Brack {}       -> failWithTc illegalBracket
            }
 
          -- Brackets are desugared to code that mentions the TH package
        ; recordThUse
 
        ; case isTypedBracket br_body of
-            True  -> do { (body', fvs_e) <- setStage (Brack cur_stage RnPendingTyped) $
-                                            rn_bracket cur_stage br_body
-                        ; return (HsBracket body', fvs_e) }
-
-            False -> do { ps_var <- newMutVar []
-                        ; (body', fvs_e) <- setStage (Brack cur_stage (RnPendingUntyped ps_var)) $
-                                            rn_bracket cur_stage br_body
+            True  -> do { traceRn "Renaming typed TH bracket" empty
+                        ; (body', fvs_e) <-
+                          setStage (Brack cur_stage RnPendingTyped) $
+                                   rn_bracket cur_stage br_body
+                        ; return (HsBracket noExt body', fvs_e) }
+
+            False -> do { traceRn "Renaming untyped TH bracket" empty
+                        ; ps_var <- newMutVar []
+                        ; (body', fvs_e) <-
+                          setStage (Brack cur_stage (RnPendingUntyped ps_var)) $
+                                   rn_bracket cur_stage br_body
                         ; pendings <- readMutVar ps_var
-                        ; return (HsRnBracketOut body' pendings, fvs_e) }
+                        ; return (HsRnBracketOut noExt body' pendings, fvs_e) }
        }
 
-rn_bracket :: ThStage -> HsBracket RdrName -> RnM (HsBracket Name, FreeVars)
-rn_bracket outer_stage br@(VarBr flg rdr_name)
+rn_bracket :: ThStage -> HsBracket GhcPs -> RnM (HsBracket GhcRn, FreeVars)
+rn_bracket outer_stage br@(VarBr flg rdr_name)
   = do { name <- lookupOccRn rdr_name
        ; this_mod <- getModule
 
@@ -108,36 +131,39 @@ rn_bracket outer_stage br@(VarBr flg rdr_name)
                              | isTopLevel top_lvl
                              -> when (isExternalName name) (keepAlive name)
                              | otherwise
-                             -> do { traceRn (text "rn_bracket VarBr" <+> ppr name <+> ppr bind_lvl <+> ppr outer_stage)
+                             -> do { traceRn "rn_bracket VarBr"
+                                      (ppr name <+> ppr bind_lvl
+                                                <+> ppr outer_stage)
                                    ; checkTc (thLevel outer_stage + 1 == bind_lvl)
                                              (quotedNameStageErr br) }
                         }
                     }
-       ; return (VarBr flg name, unitFV name) }
+       ; return (VarBr flg name, unitFV name) }
 
-rn_bracket _ (ExpBr e) = do { (e', fvs) <- rnLExpr e
-                            ; return (ExpBr e', fvs) }
+rn_bracket _ (ExpBr e) = do { (e', fvs) <- rnLExpr e
+                            ; return (ExpBr e', fvs) }
 
-rn_bracket _ (PatBr p) = rnPat ThPatQuote p $ \ p' -> return (PatBr p', emptyFVs)
+rn_bracket _ (PatBr x p)
+  = rnPat ThPatQuote p $ \ p' -> return (PatBr x p', emptyFVs)
 
-rn_bracket _ (TypBr t) = do { (t', fvs) <- rnLHsType TypBrCtx t
-                            ; return (TypBr t', fvs) }
+rn_bracket _ (TypBr t) = do { (t', fvs) <- rnLHsType TypBrCtx t
+                              ; return (TypBr x t', fvs) }
 
-rn_bracket _ (DecBrL decls)
+rn_bracket _ (DecBrL decls)
   = do { group <- groupDecls decls
        ; gbl_env  <- getGblEnv
        ; let new_gbl_env = gbl_env { tcg_dus = emptyDUs }
                           -- The emptyDUs is so that we just collect uses for this
                           -- group alone in the call to rnSrcDecls below
        ; (tcg_env, group') <- setGblEnv new_gbl_env $
-                              rnSrcDecls Nothing group
+                              rnSrcDecls group
 
               -- Discard the tcg_env; it contains only extra info about fixity
-        ; traceRn (text "rn_bracket dec" <+> (ppr (tcg_dus tcg_env) $$
-                   ppr (duUses (tcg_dus tcg_env))))
-        ; return (DecBrG group', duUses (tcg_dus tcg_env)) }
+        ; traceRn "rn_bracket dec" (ppr (tcg_dus tcg_env) $$
+                   ppr (duUses (tcg_dus tcg_env)))
+        ; return (DecBrG group', duUses (tcg_dus tcg_env)) }
   where
-    groupDecls :: [LHsDecl RdrName] -> RnM (HsGroup RdrName)
+    groupDecls :: [LHsDecl GhcPs] -> RnM (HsGroup GhcPs)
     groupDecls decls
       = do { (group, mb_splice) <- findSplice decls
            ; case mb_splice of
@@ -149,47 +175,36 @@ rn_bracket _ (DecBrL decls)
                   }
            }}
 
-rn_bracket _ (DecBrG _) = panic "rn_bracket: unexpected DecBrG"
+rn_bracket _ (DecBrG {}) = panic "rn_bracket: unexpected DecBrG"
 
-rn_bracket _ (TExpBr e) = do { (e', fvs) <- rnLExpr e
-                             ; return (TExpBr e', fvs) }
+rn_bracket _ (TExpBr e) = do { (e', fvs) <- rnLExpr e
+                               ; return (TExpBr x e', fvs) }
 
-quotationCtxtDoc :: HsBracket RdrName -> SDoc
+rn_bracket _ (XBracket {}) = panic "rn_bracket: unexpected XBracket"
+
+quotationCtxtDoc :: HsBracket GhcPs -> SDoc
 quotationCtxtDoc br_body
-  = hang (ptext (sLit "In the Template Haskell quotation"))
+  = hang (text "In the Template Haskell quotation")
          2 (ppr br_body)
 
 illegalBracket :: SDoc
-illegalBracket = ptext (sLit "Template Haskell brackets cannot be nested (without intervening splices)")
+illegalBracket =
+    text "Template Haskell brackets cannot be nested" <+>
+    text "(without intervening splices)"
 
 illegalTypedBracket :: SDoc
-illegalTypedBracket = ptext (sLit "Typed brackets may only appear in typed slices.")
+illegalTypedBracket =
+    text "Typed brackets may only appear in typed splices."
 
 illegalUntypedBracket :: SDoc
-illegalUntypedBracket = ptext (sLit "Untyped brackets may only appear in untyped slices.")
+illegalUntypedBracket =
+    text "Untyped brackets may only appear in untyped splices."
 
-quotedNameStageErr :: HsBracket RdrName -> SDoc
+quotedNameStageErr :: HsBracket GhcPs -> SDoc
 quotedNameStageErr br
-  = sep [ ptext (sLit "Stage error: the non-top-level quoted name") <+> ppr br
-        , ptext (sLit "must be used at the same stage at which is is bound")]
-
-#ifndef GHCI
-rnTopSpliceDecls :: HsSplice RdrName -> RnM ([LHsDecl RdrName], FreeVars)
-rnTopSpliceDecls e = failTH e "Template Haskell top splice"
-
-rnSpliceType :: HsSplice RdrName -> PostTc Name Kind
-             -> RnM (HsType Name, FreeVars)
-rnSpliceType e _ = failTH e "Template Haskell type splice"
-
-rnSpliceExpr :: HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
-rnSpliceExpr e = failTH e "Template Haskell splice"
-
-rnSplicePat :: HsSplice RdrName -> RnM (Either (Pat RdrName) (Pat Name), FreeVars)
-rnSplicePat e = failTH e "Template Haskell pattern splice"
+  = sep [ text "Stage error: the non-top-level quoted name" <+> ppr br
+        , text "must be used at the same stage at which it is bound" ]
 
-rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
-rnSpliceDecl e = failTH e "Template Haskell declaration splice"
-#else
 
 {-
 *********************************************************
@@ -227,9 +242,11 @@ returns a bogus term/type, so that it can report more than one error.
 We don't want the type checker to see these bogus unbound variables.
 -}
 
-rnSpliceGen :: (HsSplice Name -> RnM (a, FreeVars))     -- Outside brackets, run splice
-            -> (HsSplice Name -> (PendingRnSplice, a))  -- Inside brackets, make it pending
-            -> HsSplice RdrName
+rnSpliceGen :: (HsSplice GhcRn -> RnM (a, FreeVars))
+                                            -- Outside brackets, run splice
+            -> (HsSplice GhcRn -> (PendingRnSplice, a))
+                                            -- Inside brackets, make it pending
+            -> HsSplice GhcPs
             -> RnM (a, FreeVars)
 rnSpliceGen run_splice pend_splice splice
   = addErrCtxt (spliceCtxt splice) $ do
@@ -252,7 +269,7 @@ rnSpliceGen run_splice pend_splice splice
                 ; return (result, fvs) }
 
         _ ->  do { (splice', fvs1) <- checkNoErrs $
-                                      setStage (Splice is_typed_splice) $
+                                      setStage (Splice splice_type) $
                                       rnSplice splice
                    -- checkNoErrs: don't attempt to run the splice if
                    -- renaming it failed; otherwise we get a cascade of
@@ -261,35 +278,50 @@ rnSpliceGen run_splice pend_splice splice
                  ; return (result, fvs1 `plusFV` fvs2) } }
    where
      is_typed_splice = isTypedSplice splice
+     splice_type = if is_typed_splice
+                   then Typed
+                   else Untyped
 
 ------------------
+
+-- | Returns the result of running a splice and the modFinalizers collected
+-- during the execution.
+--
+-- See Note [Delaying modFinalizers in untyped splices].
 runRnSplice :: UntypedSpliceFlavour
-            -> (LHsExpr Id -> TcRn res)
+            -> (LHsExpr GhcTc -> TcRn res)
             -> (res -> SDoc)    -- How to pretty-print res
                                 -- Usually just ppr, but not for [Decl]
-            -> HsSplice Name    -- Always untyped
-            -> TcRn res
+            -> HsSplice GhcRn   -- Always untyped
+            -> TcRn (res, [ForeignRef (TH.Q ())])
 runRnSplice flavour run_meta ppr_res splice
   = do { splice' <- getHooked runRnSpliceHook return >>= ($ splice)
 
        ; let the_expr = case splice' of
-                  HsUntypedSplice _ e     ->  e
-                  HsQuasiQuote _ q qs str -> mkQuasiQuoteExpr flavour q qs str
-                  HsTypedSplice {}        -> pprPanic "runRnSplice" (ppr splice)
+                HsUntypedSplice _ _ _ e   ->  e
+                HsQuasiQuote _ _ q qs str -> mkQuasiQuoteExpr flavour q qs str
+                HsTypedSplice {}          -> pprPanic "runRnSplice" (ppr splice)
+                HsSpliced {}              -> pprPanic "runRnSplice" (ppr splice)
+                HsSplicedT {}             -> pprPanic "runRnSplice" (ppr splice)
+                XSplice {}                -> pprPanic "runRnSplice" (ppr splice)
 
              -- Typecheck the expression
        ; meta_exp_ty   <- tcMetaTy meta_ty_name
-       ; zonked_q_expr <- tcTopSpliceExpr False $
-                          tcMonoExpr the_expr meta_exp_ty
+       ; zonked_q_expr <- zonkTopLExpr =<<
+                            tcTopSpliceExpr Untyped
+                              (tcPolyExpr the_expr meta_exp_ty)
 
              -- Run the expression
-       ; result <- run_meta zonked_q_expr
+       ; mod_finalizers_ref <- newTcRef []
+       ; result <- setStage (RunSplice mod_finalizers_ref) $
+                     run_meta zonked_q_expr
+       ; mod_finalizers <- readTcRef mod_finalizers_ref
        ; traceSplice (SpliceInfo { spliceDescription = what
                                  , spliceIsDecl      = is_decl
                                  , spliceSource      = Just the_expr
                                  , spliceGenerated   = ppr_res result })
 
-       ; return result }
+       ; return (result, mod_finalizers) }
 
   where
     meta_ty_name = case flavour of
@@ -308,26 +340,34 @@ runRnSplice flavour run_meta ppr_res splice
 
 ------------------
 makePending :: UntypedSpliceFlavour
-            -> HsSplice Name
+            -> HsSplice GhcRn
             -> PendingRnSplice
-makePending flavour (HsUntypedSplice n e)
+makePending flavour (HsUntypedSplice _ _ n e)
   = PendingRnSplice flavour n e
-makePending flavour (HsQuasiQuote n quoter q_span quote)
+makePending flavour (HsQuasiQuote n quoter q_span quote)
   = PendingRnSplice flavour n (mkQuasiQuoteExpr flavour quoter q_span quote)
 makePending _ splice@(HsTypedSplice {})
   = pprPanic "makePending" (ppr splice)
+makePending _ splice@(HsSpliced {})
+  = pprPanic "makePending" (ppr splice)
+makePending _ splice@(HsSplicedT {})
+  = pprPanic "makePending" (ppr splice)
+makePending _ splice@(XSplice {})
+  = pprPanic "makePending" (ppr splice)
 
 ------------------
-mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString -> LHsExpr Name
+mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString
+                 -> LHsExpr GhcRn
 -- Return the expression (quoter "...quote...")
 -- which is what we must run in a quasi-quote
 mkQuasiQuoteExpr flavour quoter q_span quote
-  = L q_span $ HsApp (L q_span $
-                      HsApp (L q_span (HsVar quote_selector)) quoterExpr)
+  = cL q_span $ HsApp noExt (cL q_span
+              $ HsApp noExt (cL q_span (HsVar noExt (cL q_span quote_selector)))
+                            quoterExpr)
                      quoteExpr
   where
-    quoterExpr = L q_span $! HsVar $! quoter
-    quoteExpr  = L q_span $! HsLit $! HsString "" quote
+    quoterExpr = cL q_span $! HsVar noExt $! (cL q_span quoter)
+    quoteExpr  = cL q_span $! HsLit noExt $! HsString NoSourceText quote
     quote_selector = case flavour of
                        UntypedExpSplice  -> quoteExpName
                        UntypedPatSplice  -> quotePatName
@@ -335,37 +375,23 @@ mkQuasiQuoteExpr flavour quoter q_span quote
                        UntypedDeclSplice -> quoteDecName
 
 ---------------------
-rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
+rnSplice :: HsSplice GhcPs -> RnM (HsSplice GhcRn, FreeVars)
 -- Not exported...used for all
-rnSplice (HsTypedSplice splice_name expr)
-  = do  { checkTH expr "Template Haskell typed splice"
-        ; loc  <- getSrcSpanM
-        ; n' <- newLocalBndrRn (L loc splice_name)
+rnSplice (HsTypedSplice x hasParen splice_name expr)
+  = do  { loc  <- getSrcSpanM
+        ; n' <- newLocalBndrRn (cL loc splice_name)
         ; (expr', fvs) <- rnLExpr expr
-        ; return (HsTypedSplice n' expr', fvs) }
+        ; return (HsTypedSplice x hasParen n' expr', fvs) }
 
-rnSplice (HsUntypedSplice splice_name expr)
-  = do  { checkTH expr "Template Haskell untyped splice"
-        ; loc  <- getSrcSpanM
-        ; n' <- newLocalBndrRn (L loc splice_name)
+rnSplice (HsUntypedSplice x hasParen splice_name expr)
+  = do  { loc  <- getSrcSpanM
+        ; n' <- newLocalBndrRn (cL loc splice_name)
         ; (expr', fvs) <- rnLExpr expr
-        ; return (HsUntypedSplice n' expr', fvs) }
-
-rnSplice (HsQuasiQuote splice_name quoter q_loc quote)
-  = do  { checkTH quoter "Template Haskell quasi-quote"
-        ; loc  <- getSrcSpanM
-        ; splice_name' <- newLocalBndrRn (L loc splice_name)
-
-          -- Drop the leading "$" from the quoter name, if present
-          -- This is old-style syntax, now deprecated
-          -- NB: when removing this backward-compat, remove
-          --     the matching code in Lexer.x (around line 310)
-        ; let occ_str = occNameString (rdrNameOcc quoter)
-        ; quoter <- if ASSERT( not (null occ_str) )  -- Lexer ensures this
-                       head occ_str /= '$'
-                    then return quoter
-                    else do { addWarn (deprecatedDollar quoter)
-                            ; return (mkRdrUnqual (mkVarOcc (tail occ_str))) }
+        ; return (HsUntypedSplice x hasParen n' expr', fvs) }
+
+rnSplice (HsQuasiQuote x splice_name quoter q_loc quote)
+  = do  { loc  <- getSrcSpanM
+        ; splice_name' <- newLocalBndrRn (cL loc splice_name)
 
           -- Rename the quoter; akin to the HsVar case of rnExpr
         ; quoter' <- lookupOccRn quoter
@@ -373,96 +399,285 @@ rnSplice (HsQuasiQuote splice_name quoter q_loc quote)
         ; when (nameIsLocalOrFrom this_mod quoter') $
           checkThLocalName quoter'
 
-        ; return (HsQuasiQuote splice_name' quoter' q_loc quote, unitFV quoter') }
-
-deprecatedDollar :: RdrName -> SDoc
-deprecatedDollar quoter
-  = hang (ptext (sLit "Deprecated syntax:"))
-       2 (ptext (sLit "quasiquotes no longer need a dollar sign:")
-          <+> ppr quoter)
+        ; return (HsQuasiQuote x splice_name' quoter' q_loc quote
+                                                             , unitFV quoter') }
 
+rnSplice splice@(HsSpliced {}) = pprPanic "rnSplice" (ppr splice)
+rnSplice splice@(HsSplicedT {}) = pprPanic "rnSplice" (ppr splice)
+rnSplice splice@(XSplice {})   = pprPanic "rnSplice" (ppr splice)
 
 ---------------------
-rnSpliceExpr :: HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
+rnSpliceExpr :: HsSplice GhcPs -> RnM (HsExpr GhcRn, FreeVars)
 rnSpliceExpr splice
   = rnSpliceGen run_expr_splice pend_expr_splice splice
   where
-    pend_expr_splice :: HsSplice Name -> (PendingRnSplice, HsExpr Name)
+    pend_expr_splice :: HsSplice GhcRn -> (PendingRnSplice, HsExpr GhcRn)
     pend_expr_splice rn_splice
-        = (makePending UntypedExpSplice rn_splice, HsSpliceE rn_splice)
+        = (makePending UntypedExpSplice rn_splice, HsSpliceE noExt rn_splice)
 
-    run_expr_splice :: HsSplice Name -> RnM (HsExpr Name, FreeVars)
+    run_expr_splice :: HsSplice GhcRn -> RnM (HsExpr GhcRn, FreeVars)
     run_expr_splice rn_splice
       | isTypedSplice rn_splice   -- Run it later, in the type checker
       = do {  -- Ugh!  See Note [Splices] above
-             lcl_rdr <- getLocalRdrEnv
+             traceRn "rnSpliceExpr: typed expression splice" empty
+           ; lcl_rdr <- getLocalRdrEnv
            ; gbl_rdr <- getGlobalRdrEnv
            ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr
                                                      , isLocalGRE gre]
                  lcl_names = mkNameSet (localRdrEnvElts lcl_rdr)
 
-           ; return (HsSpliceE rn_splice, lcl_names `plusFV` gbl_names) }
+           ; return (HsSpliceE noExt rn_splice, lcl_names `plusFV` gbl_names) }
 
-      | otherwise  -- Run it here
-      = do { rn_expr <- runRnSplice UntypedExpSplice runMetaE ppr rn_splice
+      | otherwise  -- Run it here, see Note [Running splices in the Renamer]
+      = do { traceRn "rnSpliceExpr: untyped expression splice" empty
+           ; (rn_expr, mod_finalizers) <-
+                runRnSplice UntypedExpSplice runMetaE ppr rn_splice
            ; (lexpr3, fvs) <- checkNoErrs (rnLExpr rn_expr)
-           ; return (HsPar lexpr3, fvs)  }
+             -- See Note [Delaying modFinalizers in untyped splices].
+           ; return ( HsPar noExt $ HsSpliceE noExt
+                            . HsSpliced noExt (ThModFinalizers mod_finalizers)
+                            . HsSplicedExpr <$>
+                            lexpr3
+                    , fvs)
+           }
+
+{- Note [Running splices in the Renamer]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Splices used to be run in the typechecker, which led to (#4364). Since the
+renamer must decide which expressions depend on which others, and it cannot
+reliably do this for arbitrary splices, we used to conservatively say that
+splices depend on all other expressions in scope. Unfortunately, this led to
+the problem of cyclic type declarations seen in (#4364). Instead, by
+running splices in the renamer, we side-step the problem of determining
+dependencies: by the time the dependency analysis happens, any splices have
+already been run, and expression dependencies can be determined as usual.
+
+However, see (#9813), for an example where we would like to run splices
+*after* performing dependency analysis (that is, after renaming). It would be
+desirable to typecheck "non-splicy" expressions (those expressions that do not
+contain splices directly or via dependence on an expression that does) before
+"splicy" expressions, such that types/expressions within the same declaration
+group would be available to `reify` calls, for example consider the following:
+
+> module M where
+>   data D = C
+>   f = 1
+>   g = $(mapM reify ['f, 'D, ''C] ...)
+
+Compilation of this example fails since D/C/f are not in the type environment
+and thus cannot be reified as they have not been typechecked by the time the
+splice is renamed and thus run.
+
+These requirements are at odds: we do not want to run splices in the renamer as
+we wish to first determine dependencies and typecheck certain expressions,
+making them available to reify, but cannot accurately determine dependencies
+without running splices in the renamer!
+
+Indeed, the conclusion of (#9813) was that it is not worth the complexity
+to try and
+ a) implement and maintain the code for renaming/typechecking non-splicy
+    expressions before splicy expressions,
+ b) explain to TH users which expressions are/not available to reify at any
+    given point.
+
+-}
+
+{- Note [Delaying modFinalizers in untyped splices]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+When splices run in the renamer, 'reify' does not have access to the local
+type environment (#11832, [1]).
+
+For instance, in
+
+> let x = e in $(reify (mkName "x") >>= runIO . print >> [| return () |])
+
+'reify' cannot find @x@, because the local type environment is not yet
+populated. To address this, we allow 'reify' execution to be deferred with
+'addModFinalizer'.
+
+> let x = e in $(do addModFinalizer (reify (mkName "x") >>= runIO . print)
+                    [| return () |]
+                )
+
+The finalizer is run with the local type environment when type checking is
+complete.
+
+Since the local type environment is not available in the renamer, we annotate
+the tree at the splice point [2] with @HsSpliceE (HsSpliced finalizers e)@ where
+@e@ is the result of splicing and @finalizers@ are the finalizers that have been
+collected during evaluation of the splice [3]. In our example,
+
+> HsLet
+>   (x = e)
+>   (HsSpliceE $ HsSpliced [reify (mkName "x") >>= runIO . print]
+>                          (HsSplicedExpr $ return ())
+>   )
+
+When the typechecker finds the annotation, it inserts the finalizers in the
+global environment and exposes the current local environment to them [4, 5, 6].
+
+> addModFinalizersWithLclEnv [reify (mkName "x") >>= runIO . print]
+
+References:
+
+[1] https://gitlab.haskell.org/ghc/ghc/wikis/template-haskell/reify
+[2] 'rnSpliceExpr'
+[3] 'TcSplice.qAddModFinalizer'
+[4] 'TcExpr.tcExpr' ('HsSpliceE' ('HsSpliced' ...))
+[5] 'TcHsType.tc_hs_type' ('HsSpliceTy' ('HsSpliced' ...))
+[6] 'TcPat.tc_pat' ('SplicePat' ('HsSpliced' ...))
+
+-}
 
 ----------------------
-rnSpliceType :: HsSplice RdrName -> PostTc Name Kind
-             -> RnM (HsType Name, FreeVars)
-rnSpliceType splice k
+rnSpliceType :: HsSplice GhcPs -> RnM (HsType GhcRn, FreeVars)
+rnSpliceType splice
   = rnSpliceGen run_type_splice pend_type_splice splice
   where
     pend_type_splice rn_splice
-       = (makePending UntypedTypeSplice rn_splice, HsSpliceTy rn_splice k)
+       = ( makePending UntypedTypeSplice rn_splice
+         , HsSpliceTy noExt rn_splice)
 
     run_type_splice rn_splice
-      = do { hs_ty2 <- runRnSplice UntypedTypeSplice runMetaT ppr rn_splice
+      = do { traceRn "rnSpliceType: untyped type splice" empty
+           ; (hs_ty2, mod_finalizers) <-
+                runRnSplice UntypedTypeSplice runMetaT ppr rn_splice
            ; (hs_ty3, fvs) <- do { let doc = SpliceTypeCtx hs_ty2
                                  ; checkNoErrs $ rnLHsType doc hs_ty2 }
                                     -- checkNoErrs: see Note [Renamer errors]
-           ; return (HsParTy hs_ty3, fvs) }
+             -- See Note [Delaying modFinalizers in untyped splices].
+           ; return ( HsParTy noExt $ HsSpliceTy noExt
+                              . HsSpliced noExt (ThModFinalizers mod_finalizers)
+                              . HsSplicedTy <$>
+                              hs_ty3
+                    , fvs
+                    ) }
               -- Wrap the result of the splice in parens so that we don't
               -- lose the outermost location set by runQuasiQuote (#7918)
 
+{- Note [Partial Type Splices]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Partial Type Signatures are partially supported in TH type splices: only
+anonymous wild cards are allowed.
+
+  -- ToDo: SLPJ says: I don't understand all this
+
+Normally, named wild cards are collected before renaming a (partial) type
+signature. However, TH type splices are run during renaming, i.e. after the
+initial traversal, leading to out of scope errors for named wild cards. We
+can't just extend the initial traversal to collect the named wild cards in TH
+type splices, as we'd need to expand them, which is supposed to happen only
+once, during renaming.
+
+Similarly, the extra-constraints wild card is handled right before renaming
+too, and is therefore also not supported in a TH type splice. Another reason
+to forbid extra-constraints wild cards in TH type splices is that a single
+signature can contain many TH type splices, whereas it mustn't contain more
+than one extra-constraints wild card. Enforcing would this be hard the way
+things are currently organised.
+
+Anonymous wild cards pose no problem, because they start out without names and
+are given names during renaming. These names are collected right after
+renaming. The names generated for anonymous wild cards in TH type splices will
+thus be collected as well.
+
+For more details about renaming wild cards, see RnTypes.rnHsSigWcType
+
+Note that partial type signatures are fully supported in TH declaration
+splices, e.g.:
+
+     [d| foo :: _ => _
+         foo x y = x == y |]
+
+This is because in this case, the partial type signature can be treated as a
+whole signature, instead of as an arbitrary type.
+
+-}
+
+
 ----------------------
 -- | Rename a splice pattern. See Note [rnSplicePat]
-rnSplicePat :: HsSplice RdrName -> RnM ( Either (Pat RdrName) (Pat Name)
+rnSplicePat :: HsSplice GhcPs -> RnM ( Either (Pat GhcPs) (Pat GhcRn)
                                        , FreeVars)
 rnSplicePat splice
   = rnSpliceGen run_pat_splice pend_pat_splice splice
   where
+    pend_pat_splice :: HsSplice GhcRn ->
+                       (PendingRnSplice, Either b (Pat GhcRn))
     pend_pat_splice rn_splice
-      = (makePending UntypedPatSplice rn_splice, Right (SplicePat rn_splice))
+      = (makePending UntypedPatSplice rn_splice
+        , Right (SplicePat noExt rn_splice))
 
+    run_pat_splice :: HsSplice GhcRn ->
+                      RnM (Either (Pat GhcPs) (Pat GhcRn), FreeVars)
     run_pat_splice rn_splice
-      = do { pat <- runRnSplice UntypedPatSplice runMetaP ppr rn_splice
-           ; return (Left (ParPat pat), emptyFVs) }
+      = do { traceRn "rnSplicePat: untyped pattern splice" empty
+           ; (pat, mod_finalizers) <-
+                runRnSplice UntypedPatSplice runMetaP ppr rn_splice
+             -- See Note [Delaying modFinalizers in untyped splices].
+           ; return ( Left $ ParPat noExt $ ((SplicePat noExt)
+                              . HsSpliced noExt (ThModFinalizers mod_finalizers)
+                              . HsSplicedPat)  `onHasSrcSpan`
+                              pat
+                    , emptyFVs
+                    ) }
               -- Wrap the result of the quasi-quoter in parens so that we don't
               -- lose the outermost location set by runQuasiQuote (#7918)
 
 ----------------------
-rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
-rnSpliceDecl (SpliceDecl (L loc splice) flg)
+rnSpliceDecl :: SpliceDecl GhcPs -> RnM (SpliceDecl GhcRn, FreeVars)
+rnSpliceDecl (SpliceDecl _ (dL->L loc splice) flg)
   = rnSpliceGen run_decl_splice pend_decl_splice splice
   where
     pend_decl_splice rn_splice
-       = (makePending UntypedDeclSplice rn_splice, SpliceDecl (L loc rn_splice) flg)
+       = ( makePending UntypedDeclSplice rn_splice
+         , SpliceDecl noExt (cL loc rn_splice) flg)
 
     run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (ppr rn_splice)
+rnSpliceDecl (XSpliceDecl _) = panic "rnSpliceDecl"
 
-rnTopSpliceDecls :: HsSplice RdrName -> RnM ([LHsDecl RdrName], FreeVars)
+rnTopSpliceDecls :: HsSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeVars)
 -- Declaration splice at the very top level of the module
 rnTopSpliceDecls splice
-   = do  { (rn_splice, fvs) <- setStage (Splice False) $
+   = do  { (rn_splice, fvs) <- checkNoErrs $
+                               setStage (Splice Untyped) $
                                rnSplice splice
-         ; decls <- runRnSplice UntypedDeclSplice runMetaD ppr_decls rn_splice
+           -- As always, be sure to checkNoErrs above lest we end up with
+           -- holes making it to typechecking, hence #12584.
+           --
+           -- Note that we cannot call checkNoErrs for the whole duration
+           -- of rnTopSpliceDecls. The reason is that checkNoErrs changes
+           -- the local environment to temporarily contain a new
+           -- reference to store errors, and add_mod_finalizers would
+           -- cause this reference to be stored after checkNoErrs finishes.
+           -- This is checked by test TH_finalizer.
+         ; traceRn "rnTopSpliceDecls: untyped declaration splice" empty
+         ; (decls, mod_finalizers) <- checkNoErrs $
+               runRnSplice UntypedDeclSplice runMetaD ppr_decls rn_splice
+         ; add_mod_finalizers_now mod_finalizers
          ; return (decls,fvs) }
    where
-     ppr_decls :: [LHsDecl RdrName] -> SDoc
+     ppr_decls :: [LHsDecl GhcPs] -> SDoc
      ppr_decls ds = vcat (map ppr ds)
 
+     -- Adds finalizers to the global environment instead of delaying them
+     -- to the type checker.
+     --
+     -- Declaration splices do not have an interesting local environment so
+     -- there is no point in delaying them.
+     --
+     -- See Note [Delaying modFinalizers in untyped splices].
+     add_mod_finalizers_now :: [ForeignRef (TH.Q ())] -> TcRn ()
+     add_mod_finalizers_now []             = return ()
+     add_mod_finalizers_now mod_finalizers = do
+       th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv
+       env <- getLclEnv
+       updTcRef th_modfinalizers_var $ \fins ->
+         (env, ThModFinalizers mod_finalizers) : fins
+
+
 {-
 Note [rnSplicePat]
 ~~~~~~~~~~~~~~~~~~
@@ -478,8 +693,10 @@ the CpsRn monad.
 The problem is that if we're renaming a splice within a bracket, we
 *don't* want to run the splice now. We really do just want to rename
 it to an HsSplice Name. Of course, then we can't know what variables
-are bound within the splice, so pattern splices within brackets aren't
-all that useful.
+are bound within the splice. So we accept any unbound variables and
+rename them again when the bracket is spliced in.  If a variable is brought
+into scope by a pattern splice all is fine.  If it is not then an error is
+reported.
 
 In any case, when we're done in rnSplicePat, we'll either have a
 Pat RdrName (the result of running a top-level splice) or a Pat Name
@@ -487,24 +704,27 @@ Pat RdrName (the result of running a top-level splice) or a Pat Name
 rnSplicePat.
 -}
 
-spliceCtxt :: HsSplice RdrName -> SDoc
+spliceCtxt :: HsSplice GhcPs -> SDoc
 spliceCtxt splice
-  = hang (ptext (sLit "In the") <+> what) 2 (ppr splice)
+  = hang (text "In the" <+> what) 2 (ppr splice)
   where
     what = case splice of
-             HsUntypedSplice {} -> ptext (sLit "untyped splice:")
-             HsTypedSplice   {} -> ptext (sLit "typed splice:")
-             HsQuasiQuote    {} -> ptext (sLit "quasi-quotation:")
+             HsUntypedSplice {} -> text "untyped splice:"
+             HsTypedSplice   {} -> text "typed splice:"
+             HsQuasiQuote    {} -> text "quasi-quotation:"
+             HsSpliced       {} -> text "spliced expression:"
+             HsSplicedT      {} -> text "spliced expression:"
+             XSplice         {} -> text "spliced expression:"
 
 -- | The splice data to be logged
 data SpliceInfo
   = SpliceInfo
-    { spliceDescription   :: String
-    , spliceSource        :: Maybe (LHsExpr Name)  -- Nothing <=> top-level decls
-                                                   --        added by addTopDecls
-    , spliceIsDecl        :: Bool    -- True <=> put the generate code in a file
-                                     --          when -dth-dec-file is on
-    , spliceGenerated     :: SDoc
+    { spliceDescription  :: String
+    , spliceSource       :: Maybe (LHsExpr GhcRn) -- Nothing <=> top-level decls
+                                                  --        added by addTopDecls
+    , spliceIsDecl       :: Bool    -- True <=> put the generate code in a file
+                                    --          when -dth-dec-file is on
+    , spliceGenerated    :: SDoc
     }
         -- Note that 'spliceSource' is *renamed* but not *typechecked*
         -- Reason (a) less typechecking crap
@@ -518,8 +738,8 @@ traceSplice :: SpliceInfo -> TcM ()
 traceSplice (SpliceInfo { spliceDescription = sd, spliceSource = mb_src
                         , spliceGenerated = gen, spliceIsDecl = is_decl })
   = do { loc <- case mb_src of
-                   Nothing        -> getSrcSpanM
-                   Just (L loc _) -> return loc
+                   Nothing           -> getSrcSpanM
+                   Just (dL->L loc _) -> return loc
        ; traceOptTcRn Opt_D_dump_splices (spliceDebugDoc loc)
 
        ; when is_decl $  -- Raw material for -dth-dec-file
@@ -544,17 +764,10 @@ traceSplice (SpliceInfo { spliceDescription = sd, spliceSource = mb_src
              , gen ]
 
 illegalTypedSplice :: SDoc
-illegalTypedSplice = ptext (sLit "Typed splices may not appear in untyped brackets")
+illegalTypedSplice = text "Typed splices may not appear in untyped brackets"
 
 illegalUntypedSplice :: SDoc
-illegalUntypedSplice = ptext (sLit "Untyped splices may not appear in typed brackets")
-
--- spliceResultDoc :: OutputableBndr id => LHsExpr id -> SDoc
--- spliceResultDoc expr
---  = vcat [ hang (ptext (sLit "In the splice:"))
---              2 (char '$' <> pprParendExpr expr)
---        , ptext (sLit "To see what the splice expanded to, use -ddump-splices") ]
-#endif
+illegalUntypedSplice = text "Untyped splices may not appear in typed brackets"
 
 checkThLocalName :: Name -> RnM ()
 checkThLocalName name
@@ -562,14 +775,16 @@ checkThLocalName name
   = return ()            --   $(not_in_scope args)
 
   | otherwise
-  = do  { traceRn (text "checkThLocalName" <+> ppr name)
+  = do  { traceRn "checkThLocalName" (ppr name)
         ; mb_local_use <- getStageAndBindLevel name
         ; case mb_local_use of {
              Nothing -> return () ;  -- Not a locally-bound thing
              Just (top_lvl, bind_lvl, use_stage) ->
     do  { let use_lvl = thLevel use_stage
         ; checkWellStaged (quotes (ppr name)) bind_lvl use_lvl
-        ; traceRn (text "checkThLocalName" <+> ppr name <+> ppr bind_lvl <+> ppr use_stage <+> ppr use_lvl)
+        ; traceRn "checkThLocalName" (ppr name <+> ppr bind_lvl
+                                               <+> ppr use_stage
+                                               <+> ppr use_lvl)
         ; checkCrossStageLifting top_lvl bind_lvl use_stage use_lvl name } } }
 
 --------------------------------------
@@ -613,7 +828,7 @@ check_cross_stage_lifting top_lvl name ps_var
         -- If 'x' occurs many times we may get many identical
         -- bindings of the same SplicePointName, but that doesn't
         -- matter, although it's a mite untidy.
-    do  { traceRn (text "checkCrossStageLifting" <+> ppr name)
+    do  { traceRn "checkCrossStageLifting" (ppr name)
 
           -- Construct the (lift x) expression
         ; let lift_expr   = nlHsApp (nlHsVar liftName) (nlHsVar name)
@@ -638,7 +853,7 @@ ensures that 'f' stays as a top level binding.
 
 This must be done by the renamer, not the type checker (as of old),
 because the type checker doesn't typecheck the body of untyped
-brackets (Trac #8540).
+brackets (#8540).
 
 A thing can have a bind_lvl of outerLevel, but have an internal name:
    foo = [d| op = 3