53 files changed, 360 insertions, 360 deletions
diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs
index 78a6d11632..42aa22245e 100644
--- a/compiler/deSugar/DsExpr.hs
+++ b/compiler/deSugar/DsExpr.hs
@@ -24,7 +24,11 @@ import Name
 import NameEnv
 import FamInstEnv( topNormaliseType )
 
+#ifdef GHCI
+        -- Template Haskell stuff iff bootstrapped
 import DsMeta
+#endif
+
 import HsSyn
 
 import Platform
@@ -641,7 +645,11 @@ dsExpr expr@(RecordUpd record_expr (HsRecFields { rec_flds = fields })
 -- Template Haskell stuff
 
 dsExpr (HsRnBracketOut _ _) = panic "dsExpr HsRnBracketOut"
+#ifdef GHCI
 dsExpr (HsTcBracketOut x ps) = dsBracket x ps
+#else
+dsExpr (HsTcBracketOut _ _) = panic "dsExpr HsBracketOut"
+#endif
 dsExpr (HsSpliceE s)  = pprPanic "dsExpr:splice" (ppr s)
 
 -- Arrow notation extension
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 09c252b3df..c39c83e22c 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -52,7 +52,6 @@ Library
                    containers >= 0.5 && < 0.6,
                    array      >= 0.1 && < 0.6,
                    filepath   >= 1   && < 1.5,
-                   template-haskell,
                    hpc,
                    transformers,
                    bin-package-db,
@@ -66,6 +65,7 @@ Library
     GHC-Options: -Wall -fno-warn-name-shadowing
 
     if flag(ghci)
+        Build-Depends: template-haskell
         CPP-Options: -DGHCI
         Include-Dirs: ../rts/dist/build @FFIIncludeDir@
 
@@ -164,7 +164,6 @@ Library
         IdInfo
         Lexeme
         Literal
-        DsMeta
         Llvm
         Llvm.AbsSyn
         Llvm.MetaData
@@ -567,6 +566,7 @@ Library
 
     if flag(ghci)
         Exposed-Modules:
+            DsMeta
             Convert
             ByteCodeAsm
             ByteCodeGen
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 1feb358623..d8f5169122 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -3008,7 +3008,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
@@ -3178,7 +3178,7 @@ xFlags = [
   flagSpec "StandaloneDeriving"               Opt_StandaloneDeriving,
   flagSpec "StaticPointers"                   Opt_StaticPointers,
   flagSpec' "TemplateHaskell"                 Opt_TemplateHaskell
-                                              setTemplateHaskellLoc,
+                                              checkTemplateHaskellOk,
   flagSpec "TraditionalRecordSyntax"          Opt_TraditionalRecordSyntax,
   flagSpec "TransformListComp"                Opt_TransformListComp,
   flagSpec "TupleSections"                    Opt_TupleSections,
@@ -3499,9 +3499,28 @@ setIncoherentInsts True = do
   l <- getCurLoc
   upd (\d -> d { incoherentOnLoc = l })
 
-setTemplateHaskellLoc :: TurnOnFlag -> DynP ()
-setTemplateHaskellLoc _
+checkTemplateHaskellOk :: TurnOnFlag -> DynP ()
+#ifdef GHCI
+checkTemplateHaskellOk turn_on
+  | turn_on && rtsIsProfiled
+  = addErr "You can't use Template Haskell with a profiled compiler"
+  | otherwise
   = 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
 
 {- **********************************************************************
 %*                                                                      *
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index eb772bae27..381b902018 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -94,6 +94,7 @@ import Type             ( Type )
 import PrelNames
 import {- Kind parts of -} Type         ( Kind )
 import CoreLint         ( lintInteractiveExpr )
+import DsMeta           ( templateHaskellNames )
 import VarEnv           ( emptyTidyEnv )
 import Panic
 import ConLike
@@ -101,7 +102,6 @@ import ConLike
 import GHC.Exts
 #endif
 
-import DsMeta           ( templateHaskellNames )
 import Module
 import Packages
 import RdrName
@@ -196,7 +196,9 @@ knownKeyNames :: [Name]      -- Put here to avoid loops involving DsMeta,
 knownKeyNames =              -- where templateHaskellNames are defined
     map getName wiredInThings
         ++ basicKnownKeyNames
+#ifdef GHCI
         ++ templateHaskellNames
+#endif
 
 -- -----------------------------------------------------------------------------
 
diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs
index 5d12720e2c..5306b6e800 100644
--- a/compiler/rename/RnSplice.hs
+++ b/compiler/rename/RnSplice.hs
@@ -19,172 +19,37 @@ import RdrName
 import TcRnMonad
 import Kind
 
-import RnEnv
-import RnSource         ( rnSrcDecls, findSplice )
-import RnPat            ( rnPat )
+#ifdef GHCI
+import ErrUtils         ( dumpIfSet_dyn_printer )
+import Control.Monad    ( unless, when )
+import DynFlags
+import DsMeta           ( decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, liftName )
 import LoadIface        ( loadInterfaceForName )
-import BasicTypes       ( TopLevelFlag, isTopLevel )
-import Outputable
 import Module
-import SrcLoc
-import DynFlags
-import FastString
+import RnEnv
+import RnPat            ( rnPat )
+import RnSource         ( rnSrcDecls, findSplice )
 import RnTypes          ( rnLHsType )
-
-import Control.Monad    ( unless, when )
-
-import {-# SOURCE #-} RnExpr   ( rnLExpr )
-
 import PrelNames        ( isUnboundName )
-import TcEnv            ( checkWellStaged )
-import DsMeta           ( liftName )
-
-#ifdef GHCI
-import ErrUtils         ( dumpIfSet_dyn_printer )
-import DsMeta           ( decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, )
-import TcEnv            ( tcMetaTy )
+import SrcLoc
+import TcEnv            ( checkWellStaged, tcMetaTy )
+import Outputable
+import BasicTypes       ( TopLevelFlag, isTopLevel )
+import FastString
 import Hooks
 import Var              ( Id )
 import DsMeta           ( quoteExpName, quotePatName, quoteDecName, quoteTypeName )
 import Util
 
+import {-# SOURCE #-} RnExpr   ( rnLExpr )
 import {-# SOURCE #-} TcExpr   ( tcMonoExpr )
 import {-# SOURCE #-} TcSplice ( runMetaD, runMetaE, runMetaP, runMetaT, tcTopSpliceExpr )
 #endif
 
-{-
-************************************************************************
-*                                                                      *
-        Template Haskell brackets
-*                                                                      *
-************************************************************************
--}
-
+#ifndef GHCI
 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 $
-           failWith ( vcat [ ptext (sLit "Syntax error on") <+> ppr e
-                           , ptext (sLit "Perhaps you intended to use TemplateHaskell") ] )
-
-         -- 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
-           }
-
-         -- 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
-                        ; pendings <- readMutVar ps_var
-                        ; return (HsRnBracketOut body' pendings, fvs_e) }
-       }
-
-rn_bracket :: ThStage -> HsBracket RdrName -> RnM (HsBracket Name, FreeVars)
-rn_bracket outer_stage br@(VarBr flg rdr_name)
-  = do { name <- lookupOccRn rdr_name
-       ; this_mod <- getModule
-
-       ; case flg of
-           { -- Type variables can be quoted in TH. See #5721.
-             False -> return ()
-           ; True | nameIsLocalOrFrom this_mod name ->
-                 do { mb_bind_lvl <- lookupLocalOccThLvl_maybe name
-                    ; case mb_bind_lvl of
-                        { Nothing -> return ()      -- Can happen for data constructors,
-                                                    -- but nothing needs to be done for them
-
-                        ; Just (top_lvl, bind_lvl)  -- See Note [Quoting names]
-                             | isTopLevel top_lvl
-                             -> when (isExternalName name) (keepAlive name)
-                             | otherwise
-                             -> do { traceRn (text "rn_bracket VarBr" <+> ppr name <+> ppr bind_lvl <+> ppr outer_stage)
-                                   ; checkTc (thLevel outer_stage + 1 == bind_lvl)
-                                             (quotedNameStageErr br) }
-                        }
-                    }
-           ; True | otherwise ->  -- Imported thing
-                 discardResult (loadInterfaceForName msg name)
-                     -- Reason for loadInterface: deprecation checking
-                     -- assumes that the home interface is loaded, and
-                     -- this is the only way that is going to happen
-           }
-       ; return (VarBr flg name, unitFV name) }
-  where
-    msg = ptext (sLit "Need interface for Template Haskell quoted Name")
-
-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 _ (TypBr t) = do { (t', fvs) <- rnLHsType TypBrCtx t
-                            ; return (TypBr t', fvs) }
-
-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
-
-              -- 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)) }
-  where
-    groupDecls :: [LHsDecl RdrName] -> RnM (HsGroup RdrName)
-    groupDecls decls
-      = do { (group, mb_splice) <- findSplice decls
-           ; case mb_splice of
-           { Nothing -> return group
-           ; Just (splice, rest) ->
-               do { group' <- groupDecls rest
-                  ; let group'' = appendGroups group group'
-                  ; return group'' { hs_splcds = noLoc splice : hs_splcds group' }
-                  }
-           }}
-
-rn_bracket _ (DecBrG _) = panic "rn_bracket: unexpected DecBrG"
-
-rn_bracket _ (TExpBr e) = do { (e', fvs) <- rnLExpr e
-                             ; return (TExpBr e', fvs) }
-
-quotationCtxtDoc :: HsBracket RdrName -> SDoc
-quotationCtxtDoc br_body
-  = hang (ptext (sLit "In the Template Haskell quotation"))
-         2 (ppr br_body)
-
-illegalBracket :: SDoc
-illegalBracket = ptext (sLit "Template Haskell brackets cannot be nested (without intervening splices)")
+rnBracket e _ = failTH e "Template Haskell bracket"
 
-illegalTypedBracket :: SDoc
-illegalTypedBracket = ptext (sLit "Typed brackets may only appear in typed slices.")
-
-illegalUntypedBracket :: SDoc
-illegalUntypedBracket = ptext (sLit "Untyped brackets may only appear in untyped slices.")
-
-quotedNameStageErr :: HsBracket RdrName -> 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"
 
@@ -498,6 +363,120 @@ Pat RdrName (the result of running a top-level splice) or a Pat Name
 rnSplicePat.
 -}
 
+{-
+************************************************************************
+*                                                                      *
+        Template Haskell brackets
+*                                                                      *
+************************************************************************
+-}
+
+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 $
+           failWith ( vcat [ ptext (sLit "Syntax error on") <+> ppr e
+                           , ptext (sLit "Perhaps you intended to use TemplateHaskell") ] )
+       ; checkTH e "Template Haskell bracket"
+
+         -- 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
+           }
+
+         -- 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
+                        ; pendings <- readMutVar ps_var
+                        ; return (HsRnBracketOut body' pendings, fvs_e) }
+       }
+
+rn_bracket :: ThStage -> HsBracket RdrName -> RnM (HsBracket Name, FreeVars)
+rn_bracket outer_stage br@(VarBr flg rdr_name)
+  = do { name <- lookupOccRn rdr_name
+       ; this_mod <- getModule
+
+       ; case flg of
+           { -- Type variables can be quoted in TH. See #5721.
+             False -> return ()
+           ; True | nameIsLocalOrFrom this_mod name ->
+                 do { mb_bind_lvl <- lookupLocalOccThLvl_maybe name
+                    ; case mb_bind_lvl of
+                        { Nothing -> return ()      -- Can happen for data constructors,
+                                                    -- but nothing needs to be done for them
+
+                        ; Just (top_lvl, bind_lvl)  -- See Note [Quoting names]
+                             | isTopLevel top_lvl
+                             -> when (isExternalName name) (keepAlive name)
+                             | otherwise
+                             -> do { traceRn (text "rn_bracket VarBr" <+> ppr name <+> ppr bind_lvl <+> ppr outer_stage)
+                                   ; checkTc (thLevel outer_stage + 1 == bind_lvl)
+                                             (quotedNameStageErr br) }
+                        }
+                    }
+           ; True | otherwise ->  -- Imported thing
+                 discardResult (loadInterfaceForName msg name)
+                     -- Reason for loadInterface: deprecation checking
+                     -- assumes that the home interface is loaded, and
+                     -- this is the only way that is going to happen
+           }
+       ; return (VarBr flg name, unitFV name) }
+  where
+    msg = ptext (sLit "Need interface for Template Haskell quoted Name")
+
+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 _ (TypBr t) = do { (t', fvs) <- rnLHsType TypBrCtx t
+                            ; return (TypBr t', fvs) }
+
+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
+
+              -- 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)) }
+  where
+    groupDecls :: [LHsDecl RdrName] -> RnM (HsGroup RdrName)
+    groupDecls decls
+      = do { (group, mb_splice) <- findSplice decls
+           ; case mb_splice of
+           { Nothing -> return group
+           ; Just (splice, rest) ->
+               do { group' <- groupDecls rest
+                  ; let group'' = appendGroups group group'
+                  ; return group'' { hs_splcds = noLoc splice : hs_splcds group' }
+                  }
+           }}
+
+rn_bracket _ (DecBrG _) = panic "rn_bracket: unexpected DecBrG"
+
+rn_bracket _ (TExpBr e) = do { (e', fvs) <- rnLExpr e
+                             ; return (TExpBr e', fvs) }
+
 spliceCtxt :: HsSplice RdrName -> SDoc
 spliceCtxt splice
   = hang (ptext (sLit "In the") <+> what) 2 (ppr splice)
@@ -554,12 +533,31 @@ traceSplice (SpliceInfo { spliceDescription = sd, spliceSource = mb_src
       = vcat [ text "--" <+> ppr loc <> colon <+> text "Splicing" <+> text sd
              , gen ]
 
+illegalBracket :: SDoc
+illegalBracket = ptext (sLit "Template Haskell brackets cannot be nested (without intervening splices)")
+
+illegalTypedBracket :: SDoc
+illegalTypedBracket = ptext (sLit "Typed brackets may only appear in typed slices.")
+
+illegalUntypedBracket :: SDoc
+illegalUntypedBracket = ptext (sLit "Untyped brackets may only appear in untyped slices.")
+
 illegalTypedSplice :: SDoc
 illegalTypedSplice = ptext (sLit "Typed splices may not appear in untyped brackets")
 
 illegalUntypedSplice :: SDoc
 illegalUntypedSplice = ptext (sLit "Untyped splices may not appear in typed brackets")
 
+quotedNameStageErr :: HsBracket RdrName -> 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")]
+
+quotationCtxtDoc :: HsBracket RdrName -> SDoc
+quotationCtxtDoc br_body
+  = hang (ptext (sLit "In the Template Haskell quotation"))
+         2 (ppr br_body)
+
 -- spliceResultDoc :: OutputableBndr id => LHsExpr id -> SDoc
 -- spliceResultDoc expr
 --  = vcat [ hang (ptext (sLit "In the splice:"))
@@ -568,6 +566,13 @@ illegalUntypedSplice = ptext (sLit "Untyped splices may not appear in typed brac
 #endif
 
 checkThLocalName :: Name -> RnM ()
+#ifndef GHCI  /* GHCI and TH is off */
+--------------------------------------
+-- Check for cross-stage lifting
+checkThLocalName _name
+  = return ()
+
+#else         /* GHCI and TH is on */
 checkThLocalName name
   | isUnboundName name   -- Do not report two errors for
   = return ()            --   $(not_in_scope args)
@@ -633,6 +638,7 @@ check_cross_stage_lifting top_lvl name ps_var
           -- Update the pending splices
         ; ps <- readMutVar ps_var
         ; writeMutVar ps_var (pend_splice : ps) }
+#endif /* GHCI */
 
 {-
 Note [Keeping things alive for Template Haskell]
diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index 155cdb42be..353b2b71fa 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -16,7 +16,9 @@ module TcExpr ( tcPolyExpr, tcPolyExprNC, tcMonoExpr, tcMonoExprNC,
 #include "HsVersions.h"
 
 import {-# SOURCE #-}   TcSplice( tcSpliceExpr, tcTypedBracket, tcUntypedBracket )
+#ifdef GHCI
 import DsMeta( liftStringName, liftName )
+#endif
 
 import HsSyn
 import TcHsSyn
@@ -1232,6 +1234,13 @@ tcTagToEnum loc fun_name arg res_ty
 -}
 
 checkThLocalId :: Id -> TcM ()
+#ifndef GHCI  /* GHCI and TH is off */
+--------------------------------------
+-- Check for cross-stage lifting
+checkThLocalId _id
+  = return ()
+
+#else         /* GHCI and TH is on */
 checkThLocalId id
   = do  { mb_local_use <- getStageAndBindLevel (idName id)
         ; case mb_local_use of
@@ -1294,6 +1303,7 @@ checkCrossStageLifting _ _ = return ()
 polySpliceErr :: Id -> SDoc
 polySpliceErr id
   = ptext (sLit "Can't splice the polymorphic local variable") <+> quotes (ppr id)
+#endif /* GHCI */
 
 {-
 Note [Lifting strings]
diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index f6b10838b8..b73f20b283 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -34,14 +34,6 @@ import Name
 import TcRnMonad
 import TcType
 
-import Outputable
-import TcExpr
-import SrcLoc
-import FastString
-import DsMeta
-import TcUnify
-import TcEnv
-
 #ifdef GHCI
 import HscMain
         -- These imports are the reason that TcSplice
@@ -53,11 +45,14 @@ import Convert
 import RnExpr
 import RnEnv
 import RnTypes
+import TcExpr
 import TcHsSyn
 import TcSimplify
+import TcUnify
 import Type
 import Kind
 import NameSet
+import TcEnv
 import TcMType
 import TcHsType
 import TcIface
@@ -86,6 +81,7 @@ import DsExpr
 import DsMonad
 import Serialized
 import ErrUtils
+import SrcLoc
 import Util
 import Data.List        ( mapAccumL )
 import Unique
@@ -96,7 +92,10 @@ import Maybes( MaybeErr(..) )
 import DynFlags
 import Panic
 import Lexeme
+import FastString
+import Outputable
 
+import DsMeta
 import qualified Language.Haskell.TH as TH
 -- THSyntax gives access to internal functions and data types
 import qualified Language.Haskell.TH.Syntax as TH
@@ -130,87 +129,10 @@ tcSpliceExpr     :: HsSplice Name  -> TcRhoType -> TcM (HsExpr TcId)
 -- runQuasiQuoteDecl :: HsQuasiQuote RdrName -> RnM [LHsDecl RdrName]
 
 runAnnotation     :: CoreAnnTarget -> LHsExpr Name -> TcM Annotation
-{-
-************************************************************************
-*                                                                      *
-\subsection{Quoting an expression}
-*                                                                      *
-************************************************************************
--}
-
--- See Note [How brackets and nested splices are handled]
--- tcTypedBracket :: HsBracket Name -> TcRhoType -> TcM (HsExpr TcId)
-tcTypedBracket brack@(TExpBr expr) res_ty
-  = addErrCtxt (quotationCtxtDoc brack) $
-    do { cur_stage <- getStage
-       ; ps_ref <- newMutVar []
-       ; lie_var <- getConstraintVar   -- Any constraints arising from nested splices
-                                       -- should get thrown into the constraint set
-                                       -- from outside the bracket
-
-       -- Typecheck expr to make sure it is valid,
-       -- Throw away the typechecked expression but return its type.
-       -- We'll typecheck it again when we splice it in somewhere
-       ; (_tc_expr, expr_ty) <- setStage (Brack cur_stage (TcPending ps_ref lie_var)) $
-                                tcInferRhoNC expr
-                                -- NC for no context; tcBracket does that
-
-       ; meta_ty <- tcTExpTy expr_ty
-       ; co <- unifyType meta_ty res_ty
-       ; ps' <- readMutVar ps_ref
-       ; texpco <- tcLookupId unsafeTExpCoerceName
-       ; return (mkHsWrapCo co (unLoc (mkHsApp (nlHsTyApp texpco [expr_ty])
-                                               (noLoc (HsTcBracketOut brack ps'))))) }
-tcTypedBracket other_brack _
-  = pprPanic "tcTypedBracket" (ppr other_brack)
-
--- tcUntypedBracket :: HsBracket Name -> [PendingRnSplice] -> TcRhoType -> TcM (HsExpr TcId)
-tcUntypedBracket brack ps res_ty
-  = do { traceTc "tc_bracket untyped" (ppr brack $$ ppr ps)
-       ; ps' <- mapM tcPendingSplice ps
-       ; meta_ty <- tcBrackTy brack
-       ; co <- unifyType meta_ty res_ty
-       ; traceTc "tc_bracket done untyped" (ppr meta_ty)
-       ; return (mkHsWrapCo co (HsTcBracketOut brack ps'))  }
-
----------------
-tcBrackTy :: HsBracket Name -> TcM TcType
-tcBrackTy (VarBr _ _) = tcMetaTy nameTyConName  -- Result type is Var (not Q-monadic)
-tcBrackTy (ExpBr _)   = tcMetaTy expQTyConName  -- Result type is ExpQ (= Q Exp)
-tcBrackTy (TypBr _)   = tcMetaTy typeQTyConName -- Result type is Type (= Q Typ)
-tcBrackTy (DecBrG _)  = tcMetaTy decsQTyConName -- Result type is Q [Dec]
-tcBrackTy (PatBr _)   = tcMetaTy patQTyConName  -- Result type is PatQ (= Q Pat)
-tcBrackTy (DecBrL _)  = panic "tcBrackTy: Unexpected DecBrL"
-tcBrackTy (TExpBr _)  = panic "tcUntypedBracket: Unexpected TExpBr"
-
----------------
-tcPendingSplice :: PendingRnSplice -> TcM PendingTcSplice
-tcPendingSplice (PendingRnSplice flavour splice_name expr)
-  = do { res_ty <- tcMetaTy meta_ty_name
-       ; expr' <- tcMonoExpr expr res_ty
-       ; return (PendingTcSplice splice_name expr') }
-  where
-     meta_ty_name = case flavour of
-                       UntypedExpSplice  -> expQTyConName
-                       UntypedPatSplice  -> patQTyConName
-                       UntypedTypeSplice -> typeQTyConName
-                       UntypedDeclSplice -> decsQTyConName
-
----------------
--- Takes a type tau and returns the type Q (TExp tau)
-tcTExpTy :: TcType -> TcM TcType
-tcTExpTy tau
-  = do { q    <- tcLookupTyCon qTyConName
-       ; texp <- tcLookupTyCon tExpTyConName
-       ; return (mkTyConApp q [mkTyConApp texp [tau]]) }
-
-quotationCtxtDoc :: HsBracket Name -> SDoc
-quotationCtxtDoc br_body
-  = hang (ptext (sLit "In the Template Haskell quotation"))
-         2 (ppr br_body)
-
 
 #ifndef GHCI
+tcTypedBracket   x _   = failTH x "Template Haskell bracket"
+tcUntypedBracket x _ _ = failTH x "Template Haskell bracket"
 tcSpliceExpr  e _      = failTH e "Template Haskell splice"
 
 -- runQuasiQuoteExpr q = failTH q "quasiquote"
@@ -403,8 +325,80 @@ When a variable is used, we compare
            g1 = $(map ...)         is OK
            g2 = $(f ...)           is not OK; because we havn't compiled f yet
 
+
+************************************************************************
+*                                                                      *
+\subsection{Quoting an expression}
+*                                                                      *
+************************************************************************
 -}
 
+-- See Note [How brackets and nested splices are handled]
+-- tcTypedBracket :: HsBracket Name -> TcRhoType -> TcM (HsExpr TcId)
+tcTypedBracket brack@(TExpBr expr) res_ty
+  = addErrCtxt (quotationCtxtDoc brack) $
+    do { cur_stage <- getStage
+       ; ps_ref <- newMutVar []
+       ; lie_var <- getConstraintVar   -- Any constraints arising from nested splices
+                                       -- should get thrown into the constraint set
+                                       -- from outside the bracket
+
+       -- Typecheck expr to make sure it is valid,
+       -- Throw away the typechecked expression but return its type.
+       -- We'll typecheck it again when we splice it in somewhere
+       ; (_tc_expr, expr_ty) <- setStage (Brack cur_stage (TcPending ps_ref lie_var)) $
+                                tcInferRhoNC expr
+                                -- NC for no context; tcBracket does that
+
+       ; meta_ty <- tcTExpTy expr_ty
+       ; co <- unifyType meta_ty res_ty
+       ; ps' <- readMutVar ps_ref
+       ; texpco <- tcLookupId unsafeTExpCoerceName
+       ; return (mkHsWrapCo co (unLoc (mkHsApp (nlHsTyApp texpco [expr_ty])
+                                               (noLoc (HsTcBracketOut brack ps'))))) }
+tcTypedBracket other_brack _
+  = pprPanic "tcTypedBracket" (ppr other_brack)
+
+-- tcUntypedBracket :: HsBracket Name -> [PendingRnSplice] -> TcRhoType -> TcM (HsExpr TcId)
+tcUntypedBracket brack ps res_ty
+  = do { traceTc "tc_bracket untyped" (ppr brack $$ ppr ps)
+       ; ps' <- mapM tcPendingSplice ps
+       ; meta_ty <- tcBrackTy brack
+       ; co <- unifyType meta_ty res_ty
+       ; traceTc "tc_bracket done untyped" (ppr meta_ty)
+       ; return (mkHsWrapCo co (HsTcBracketOut brack ps'))  }
+
+---------------
+tcBrackTy :: HsBracket Name -> TcM TcType
+tcBrackTy (VarBr _ _) = tcMetaTy nameTyConName  -- Result type is Var (not Q-monadic)
+tcBrackTy (ExpBr _)   = tcMetaTy expQTyConName  -- Result type is ExpQ (= Q Exp)
+tcBrackTy (TypBr _)   = tcMetaTy typeQTyConName -- Result type is Type (= Q Typ)
+tcBrackTy (DecBrG _)  = tcMetaTy decsQTyConName -- Result type is Q [Dec]
+tcBrackTy (PatBr _)   = tcMetaTy patQTyConName  -- Result type is PatQ (= Q Pat)
+tcBrackTy (DecBrL _)  = panic "tcBrackTy: Unexpected DecBrL"
+tcBrackTy (TExpBr _)  = panic "tcUntypedBracket: Unexpected TExpBr"
+
+---------------
+tcPendingSplice :: PendingRnSplice -> TcM PendingTcSplice
+tcPendingSplice (PendingRnSplice flavour splice_name expr)
+  = do { res_ty <- tcMetaTy meta_ty_name
+       ; expr' <- tcMonoExpr expr res_ty
+       ; return (PendingTcSplice splice_name expr') }
+  where
+     meta_ty_name = case flavour of
+                       UntypedExpSplice  -> expQTyConName
+                       UntypedPatSplice  -> patQTyConName
+                       UntypedTypeSplice -> typeQTyConName
+                       UntypedDeclSplice -> decsQTyConName
+
+---------------
+-- Takes a type tau and returns the type Q (TExp tau)
+tcTExpTy :: TcType -> TcM TcType
+tcTExpTy tau
+  = do { q    <- tcLookupTyCon qTyConName
+       ; texp <- tcLookupTyCon tExpTyConName
+       ; return (mkTyConApp q [mkTyConApp texp [tau]]) }
+
 {-
 ************************************************************************
 *                                                                      *
@@ -475,6 +469,11 @@ tcTopSplice expr res_ty
 ************************************************************************
 -}
 
+quotationCtxtDoc :: HsBracket Name -> SDoc
+quotationCtxtDoc br_body
+  = hang (ptext (sLit "In the Template Haskell quotation"))
+         2 (ppr br_body)
+
 spliceCtxtDoc :: HsSplice Name -> SDoc
 spliceCtxtDoc splice
   = hang (ptext (sLit "In the Template Haskell splice"))
diff --git a/docs/users_guide/7.12.1-notes.xml b/docs/users_guide/7.12.1-notes.xml
index 9a87588858..4dbb0b20cd 100644
--- a/docs/users_guide/7.12.1-notes.xml
+++ b/docs/users_guide/7.12.1-notes.xml
@@ -105,12 +105,7 @@
         <itemizedlist>
             <listitem>
                 <para>
-                    The <literal>TemplateHaskell</literal> 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.
+                    TODO FIXME.
                </para>
            </listitem>
        </itemizedlist>
diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml
index 303833a291..20204ca164 100644
--- a/docs/users_guide/glasgow_exts.xml
+++ b/docs/users_guide/glasgow_exts.xml
@@ -9571,8 +9571,8 @@ Typed expression splices and quotations are supported.)
 
     <listitem><para>
 	    If you are building GHC from source, you need at least a stage-2 bootstrap compiler to
-	      run Template Haskell splices and quasi-quotes.  A stage-1 compiler will only accept regular quotes of Haskell.  Reason: TH splices and quasi-quotes
-	      compile and run a program, and then looks at the result.  So it's important that
+	      run Template Haskell.  A stage-1 compiler will reject the TH constructs.  Reason: TH
+	      compiles and runs a program, and then looks at the result.  So it's important that
 	      the program it compiles produces results whose representations are identical to
 	      those of the compiler itself.
    </para></listitem>
diff --git a/ghc.mk b/ghc.mk
index 2f37be8bac..b9bba13199 100644
--- a/ghc.mk
+++ b/ghc.mk
@@ -386,7 +386,7 @@ else
 # programs such as GHC and ghc-pkg, that we do not assume the stage0
 # compiler already has installed (or up-to-date enough).
 
-PACKAGES_STAGE0 = binary Cabal/Cabal hpc bin-package-db hoopl transformers template-haskell
+PACKAGES_STAGE0 = binary Cabal/Cabal hpc bin-package-db hoopl transformers
 ifeq "$(Windows_Host)" "NO"
 ifneq "$(HostOS_CPP)" "ios"
 PACKAGES_STAGE0 += terminfo
diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal
index 60a800c589..1c53af392e 100644
--- a/libraries/template-haskell/template-haskell.cabal
+++ b/libraries/template-haskell/template-haskell.cabal
@@ -48,7 +48,7 @@ Library
         Language.Haskell.TH.Lib.Map
 
     build-depends:
-        base,
+        base       == 4.8.*,
         pretty     == 1.1.*
 
     -- We need to set the package key to template-haskell (without a
diff --git a/mk/warnings.mk b/mk/warnings.mk
index 5c41d5f9f4..30e13ba6b8 100644
--- a/mk/warnings.mk
+++ b/mk/warnings.mk
@@ -102,7 +102,6 @@ libraries/ghc-prim_dist-install_EXTRA_HC_OPTS += -fno-warn-trustworthy-safe
 libraries/Win32_dist-install_EXTRA_HC_OPTS += -fno-warn-trustworthy-safe
 
 # Temporarely disable inline rule shadowing warning
-libraries/template-haskell_dist-boot_EXTRA_HC_OPTS += -fno-warn-inline-rule-shadowing
 libraries/template-haskell_dist-install_EXTRA_HC_OPTS += -fno-warn-inline-rule-shadowing
 
 # We need -fno-warn-deprecated-flags to avoid failure with -Werror
diff --git a/testsuite/tests/quotes/.gitignore b/testsuite/tests/quotes/.gitignore
deleted file mode 100644
index 1c8a416fcd..0000000000
--- a/testsuite/tests/quotes/.gitignore
+++ /dev/null
@@ -1,4 +0,0 @@
-T3572
-T8633
-TH_ppr1
-TH_spliceViewPat/TH_spliceViewPat
diff --git a/testsuite/tests/quotes/Makefile b/testsuite/tests/quotes/Makefile
deleted file mode 100644
index 9a36a1c5fe..0000000000
--- a/testsuite/tests/quotes/Makefile
+++ /dev/null
@@ -1,3 +0,0 @@
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/quotes/T10384.hs b/testsuite/tests/quotes/T10384.hs
deleted file mode 100644
index 773deb061a..0000000000
--- a/testsuite/tests/quotes/T10384.hs
+++ /dev/null
@@ -1,3 +0,0 @@
-{-# LANGUAGE TemplateHaskell, RankNTypes, ScopedTypeVariables #-}
-module A where
-x = \(y :: forall a. a -> a) -> [|| y ||]
diff --git a/testsuite/tests/quotes/T10384.stderr b/testsuite/tests/quotes/T10384.stderr
deleted file mode 100644
index f2360fd5ba..0000000000
--- a/testsuite/tests/quotes/T10384.stderr
+++ /dev/null
@@ -1,6 +0,0 @@
-
-T10384.hs:3:37: error:
-    Can't splice the polymorphic local variable ‘y’
-    In the Template Haskell quotation [|| y ||]
-    In the expression: [|| y ||]
-    In the expression: \ (y :: forall a. a -> a) -> [|| y ||]
diff --git a/testsuite/tests/quotes/T8455.hs b/testsuite/tests/quotes/T8455.hs
deleted file mode 100644
index 69d1271b40..0000000000
--- a/testsuite/tests/quotes/T8455.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-
-module T8455 where
-
-ty = [t| 5 |]
diff --git a/testsuite/tests/quotes/TH_localname.hs b/testsuite/tests/quotes/TH_localname.hs
deleted file mode 100644
index 5bc0e96036..0000000000
--- a/testsuite/tests/quotes/TH_localname.hs
+++ /dev/null
@@ -1,3 +0,0 @@
-module TH_localname where
-
-x = \y -> [| y |]
diff --git a/testsuite/tests/quotes/TH_localname.stderr b/testsuite/tests/quotes/TH_localname.stderr
deleted file mode 100644
index a83c606eb4..0000000000
--- a/testsuite/tests/quotes/TH_localname.stderr
+++ /dev/null
@@ -1,22 +0,0 @@
-
-TH_localname.hs:3:11: error:
-    No instance for (Lift t0) arising from a use of ‘lift’
-    The type variable ‘t0’ is ambiguous
-    Relevant bindings include
-      y :: t0 (bound at TH_localname.hs:3:6)
-      x :: t0 -> ExpQ (bound at TH_localname.hs:3:1)
-    Note: there are several potential instances:
-      instance (Lift a, Lift b) => Lift (Either a b)
-        -- Defined in ‘Language.Haskell.TH.Syntax’
-      instance Lift a => Lift (Maybe a)
-        -- Defined in ‘Language.Haskell.TH.Syntax’
-      instance Lift Int16 -- Defined in ‘Language.Haskell.TH.Syntax’
-      ...plus 24 others
-    In the expression: lift y
-    In the expression:
-      [| y |]
-      pending(rn) [<y, lift y>]
-    In the expression:
-      \ y
-        -> [| y |]
-           pending(rn) [<y, lift y>]
diff --git a/testsuite/tests/quotes/all.T b/testsuite/tests/quotes/all.T
deleted file mode 100644
index a56a50c010..0000000000
--- a/testsuite/tests/quotes/all.T
+++ /dev/null
@@ -1,31 +0,0 @@
-def f(name, opts):
-    opts.extra_hc_opts = '-XTemplateHaskell -package template-haskell'
-
-setTestOpts(f)
-
-test('T2632', normal, compile, [''])
-test('T2931', normal, compile, ['-v0'])
-test('T3572', normal, compile_and_run, [''])
-test('T4056', normal, compile, ['-v0'])
-test('T4169', normal, compile, ['-v0'])
-test('T4170', normal, compile, ['-v0'])
-test('T5721', normal, compile, ['-v0'])
-test('T6062', normal, compile, ['-v0'])
-test('T8455', normal, compile, ['-v0'])
-test('T8633', normal, compile_and_run, [''])
-test('T8759a', normal, compile_fail, ['-v0'])
-test('T9824', normal, compile, ['-v0'])
-test('T10384', normal, compile_fail, [''])
-
-test('TH_tf2', normal, compile, ['-v0'])
-test('TH_ppr1', normal, compile_and_run, [''])
-test('TH_bracket1', normal, compile, [''])
-test('TH_bracket2', normal, compile, [''])
-test('TH_bracket3', normal, compile, [''])
-test('TH_scope', normal, compile, [''])
-test('TH_reifyType1', normal, compile, [''])
-test('TH_reifyType2', normal, compile, [''])
-test('TH_repE1', normal, compile, [''])
-test('TH_repE3', normal, compile, [''])
-test('TH_abstractFamily', normal, compile_fail, [''])
-test('TH_localname', normal, compile_fail, [''])
diff --git a/testsuite/tests/quotes/T2632.hs b/testsuite/tests/th/T2632.hs
index 71f6350cc2..31429e28d9 100644
--- a/testsuite/tests/quotes/T2632.hs
+++ b/testsuite/tests/th/T2632.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-}
+
 -- Trac #2632
 
 module MkData where
diff --git a/testsuite/tests/quotes/T2931.hs b/testsuite/tests/th/T2931.hs
index 43aeda0ece..01e57a934d 100644
--- a/testsuite/tests/quotes/T2931.hs
+++ b/testsuite/tests/th/T2931.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TemplateHaskell #-}
 -- Trac #2931
 
 module Foo where
diff --git a/testsuite/tests/quotes/T3572.hs b/testsuite/tests/th/T3572.hs
index 4717fd2735..4717fd2735 100644
--- a/testsuite/tests/quotes/T3572.hs
+++ b/testsuite/tests/th/T3572.hs
diff --git a/testsuite/tests/quotes/T3572.stdout b/testsuite/tests/th/T3572.stdout
index 9df7a449ff..9df7a449ff 100644
--- a/testsuite/tests/quotes/T3572.stdout
+++ b/testsuite/tests/th/T3572.stdout
diff --git a/testsuite/tests/quotes/T4056.hs b/testsuite/tests/th/T4056.hs
index a9b936987c..211d2b51f4 100644
--- a/testsuite/tests/quotes/T4056.hs
+++ b/testsuite/tests/th/T4056.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeFamilies, RankNTypes, FlexibleContexts #-}
+{-# LANGUAGE TemplateHaskell, TypeFamilies, RankNTypes, FlexibleContexts #-}
 
 module T4056 where
 import Language.Haskell.TH
diff --git a/testsuite/tests/quotes/T4169.hs b/testsuite/tests/th/T4169.hs
index cdef4a2e3a..1fa3ad7cb7 100644
--- a/testsuite/tests/quotes/T4169.hs
+++ b/testsuite/tests/th/T4169.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-}
+
 -- Crashed GHC 6.12
 
 module T4165 where
diff --git a/testsuite/tests/quotes/T4170.hs b/testsuite/tests/th/T4170.hs
index 46319abaf0..87ccad6c5b 100644
--- a/testsuite/tests/quotes/T4170.hs
+++ b/testsuite/tests/th/T4170.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TemplateHaskell #-}
 module T4170 where
 
 import Language.Haskell.TH
diff --git a/testsuite/tests/quotes/T5721.hs b/testsuite/tests/th/T5721.hs
index ed5e7e380b..60879c7570 100644
--- a/testsuite/tests/quotes/T5721.hs
+++ b/testsuite/tests/th/T5721.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
 
 module T5371 where
 import Language.Haskell.TH
diff --git a/testsuite/tests/quotes/T6062.hs b/testsuite/tests/th/T6062.hs
index 342850e853..330b3f2b8b 100644
--- a/testsuite/tests/quotes/T6062.hs
+++ b/testsuite/tests/th/T6062.hs
@@ -1,2 +1,3 @@
+{-# LANGUAGE TemplateHaskell #-}
 module T6062 where
 x = [| False True |]
diff --git a/testsuite/tests/th/T8455.hs b/testsuite/tests/th/T8455.hs
new file mode 100644
index 0000000000..08217b37d1
--- /dev/null
+++ b/testsuite/tests/th/T8455.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE TemplateHaskell, DataKinds #-}
+
+module T8455 where
+
+ty = [t| 5 |]
diff --git a/testsuite/tests/quotes/T8633.hs b/testsuite/tests/th/T8633.hs
index eb2b3f3a3b..0c73579e12 100644
--- a/testsuite/tests/quotes/T8633.hs
+++ b/testsuite/tests/th/T8633.hs
@@ -1,19 +1,19 @@
-module Main where
-import Language.Haskell.TH.Syntax
-
-t1 = case mkName "^.." of
-    Name (OccName ".")  (NameQ (ModName "^")) -> error "bug0"
-    Name (OccName "^..") NameS                -> return ()
-
-t2 = case mkName "Control.Lens.^.." of
-    Name (OccName ".")  (NameQ (ModName "Control.Lens.^")) -> error "bug1"
-    Name (OccName "^..") (NameQ (ModName "Control.Lens")) -> return ()
-
-t3 = case mkName "Data.Bits..&." of
-    Name (OccName ".&.") (NameQ (ModName "Data.Bits")) -> return ()
-
-t4 = case mkName "abcde" of
-    Name (OccName "abcde") NameS -> return ()
-
-main :: IO ()
-main = do t1; t2; t3; t4
+module Main where
+import Language.Haskell.TH.Syntax
+
+t1 = case mkName "^.." of
+    Name (OccName ".")  (NameQ (ModName "^")) -> error "bug0"
+    Name (OccName "^..") NameS                -> return ()
+
+t2 = case mkName "Control.Lens.^.." of
+    Name (OccName ".")  (NameQ (ModName "Control.Lens.^")) -> error "bug1"
+    Name (OccName "^..") (NameQ (ModName "Control.Lens")) -> return ()
+
+t3 = case mkName "Data.Bits..&." of
+    Name (OccName ".&.") (NameQ (ModName "Data.Bits")) -> return ()
+
+t4 = case mkName "abcde" of
+    Name (OccName "abcde") NameS -> return ()
+
+main :: IO ()
+main = do t1; t2; t3; t4
diff --git a/testsuite/tests/quotes/T8759a.hs b/testsuite/tests/th/T8759a.hs
index 37b65d6fcc..3d8089c2fa 100644
--- a/testsuite/tests/quotes/T8759a.hs
+++ b/testsuite/tests/th/T8759a.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE TemplateHaskell, PatternSynonyms #-}
 
 module T8759a where
 
diff --git a/testsuite/tests/quotes/T8759a.stderr b/testsuite/tests/th/T8759a.stderr
index ff0fd495df..ff0fd495df 100644
--- a/testsuite/tests/quotes/T8759a.stderr
+++ b/testsuite/tests/th/T8759a.stderr
diff --git a/testsuite/tests/quotes/T9824.hs b/testsuite/tests/th/T9824.hs
index 9a2d6fdfef..828c00893c 100644
--- a/testsuite/tests/quotes/T9824.hs
+++ b/testsuite/tests/th/T9824.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TemplateHaskell #-}
 {-# OPTIONS_GHC -fwarn-unused-matches #-}
 
 module T9824 where
diff --git a/testsuite/tests/quotes/TH_abstractFamily.hs b/testsuite/tests/th/TH_abstractFamily.hs
index 78d7e43931..78d7e43931 100644
--- a/testsuite/tests/quotes/TH_abstractFamily.hs
+++ b/testsuite/tests/th/TH_abstractFamily.hs
diff --git a/testsuite/tests/quotes/TH_abstractFamily.stderr b/testsuite/tests/th/TH_abstractFamily.stderr
index c0aa8d274b..c0aa8d274b 100644
--- a/testsuite/tests/quotes/TH_abstractFamily.stderr
+++ b/testsuite/tests/th/TH_abstractFamily.stderr
diff --git a/testsuite/tests/quotes/TH_bracket1.hs b/testsuite/tests/th/TH_bracket1.hs
index 7dee21ba01..7dee21ba01 100644
--- a/testsuite/tests/quotes/TH_bracket1.hs
+++ b/testsuite/tests/th/TH_bracket1.hs
diff --git a/testsuite/tests/quotes/TH_bracket2.hs b/testsuite/tests/th/TH_bracket2.hs
index 2b06b9eecb..2b06b9eecb 100644
--- a/testsuite/tests/quotes/TH_bracket2.hs
+++ b/testsuite/tests/th/TH_bracket2.hs
diff --git a/testsuite/tests/quotes/TH_bracket3.hs b/testsuite/tests/th/TH_bracket3.hs
index c746d61cd3..c746d61cd3 100644
--- a/testsuite/tests/quotes/TH_bracket3.hs
+++ b/testsuite/tests/th/TH_bracket3.hs
diff --git a/testsuite/tests/quotes/TH_ppr1.hs b/testsuite/tests/th/TH_ppr1.hs
index 763d7682e0..763d7682e0 100644
--- a/testsuite/tests/quotes/TH_ppr1.hs
+++ b/testsuite/tests/th/TH_ppr1.hs
diff --git a/testsuite/tests/quotes/TH_ppr1.stdout b/testsuite/tests/th/TH_ppr1.stdout
index e969c176c3..e969c176c3 100644
--- a/testsuite/tests/quotes/TH_ppr1.stdout
+++ b/testsuite/tests/th/TH_ppr1.stdout
diff --git a/testsuite/tests/quotes/TH_reifyType1.hs b/testsuite/tests/th/TH_reifyType1.hs
index d8b45db271..d8b45db271 100644
--- a/testsuite/tests/quotes/TH_reifyType1.hs
+++ b/testsuite/tests/th/TH_reifyType1.hs
diff --git a/testsuite/tests/quotes/TH_reifyType2.hs b/testsuite/tests/th/TH_reifyType2.hs
index 85615b5382..85615b5382 100644
--- a/testsuite/tests/quotes/TH_reifyType2.hs
+++ b/testsuite/tests/th/TH_reifyType2.hs
diff --git a/testsuite/tests/quotes/TH_repE1.hs b/testsuite/tests/th/TH_repE1.hs
index 1938a9bdc3..1938a9bdc3 100644
--- a/testsuite/tests/quotes/TH_repE1.hs
+++ b/testsuite/tests/th/TH_repE1.hs
diff --git a/testsuite/tests/quotes/TH_repE3.hs b/testsuite/tests/th/TH_repE3.hs
index 5f0453c1a7..5f0453c1a7 100644
--- a/testsuite/tests/quotes/TH_repE3.hs
+++ b/testsuite/tests/th/TH_repE3.hs
diff --git a/testsuite/tests/quotes/TH_scope.hs b/testsuite/tests/th/TH_scope.hs
index 7674a5d1c0..7674a5d1c0 100644
--- a/testsuite/tests/quotes/TH_scope.hs
+++ b/testsuite/tests/th/TH_scope.hs
diff --git a/testsuite/tests/quotes/TH_spliceViewPat/A.hs b/testsuite/tests/th/TH_spliceViewPat/A.hs
index 0147d2eca2..0147d2eca2 100644
--- a/testsuite/tests/quotes/TH_spliceViewPat/A.hs
+++ b/testsuite/tests/th/TH_spliceViewPat/A.hs
diff --git a/testsuite/tests/quotes/TH_spliceViewPat/Main.hs b/testsuite/tests/th/TH_spliceViewPat/Main.hs
index 675ae99bf9..675ae99bf9 100644
--- a/testsuite/tests/quotes/TH_spliceViewPat/Main.hs
+++ b/testsuite/tests/th/TH_spliceViewPat/Main.hs
diff --git a/testsuite/tests/quotes/TH_spliceViewPat/Makefile b/testsuite/tests/th/TH_spliceViewPat/Makefile
index 4a268530f1..4a268530f1 100644
--- a/testsuite/tests/quotes/TH_spliceViewPat/Makefile
+++ b/testsuite/tests/th/TH_spliceViewPat/Makefile
diff --git a/testsuite/tests/quotes/TH_spliceViewPat/TH_spliceViewPat.stdout b/testsuite/tests/th/TH_spliceViewPat/TH_spliceViewPat.stdout
index 4792e70f33..4792e70f33 100644
--- a/testsuite/tests/quotes/TH_spliceViewPat/TH_spliceViewPat.stdout
+++ b/testsuite/tests/th/TH_spliceViewPat/TH_spliceViewPat.stdout
diff --git a/testsuite/tests/quotes/TH_spliceViewPat/test.T b/testsuite/tests/th/TH_spliceViewPat/test.T
index 3075ef4b1f..21fdff3518 100644
--- a/testsuite/tests/quotes/TH_spliceViewPat/test.T
+++ b/testsuite/tests/th/TH_spliceViewPat/test.T
@@ -1,7 +1,12 @@
 def f(name, opts):
     opts.extra_hc_opts = '-XTemplateHaskell -package template-haskell'
+    if (ghc_with_interpreter == 0):
+        opts.skip = 1
 
 setTestOpts(f)
+setTestOpts(only_compiler_types(['ghc']))
+setTestOpts(only_ways(['normal','ghci']))
+setTestOpts(when(compiler_profiled(), skip))
 
 test('TH_spliceViewPat',
      extra_clean(['Main.o', 'Main.hi', 'A.o', 'A.hi']),
diff --git a/testsuite/tests/quotes/TH_tf2.hs b/testsuite/tests/th/TH_tf2.hs
index 9f313d4a3e..9f313d4a3e 100644
--- a/testsuite/tests/quotes/TH_tf2.hs
+++ b/testsuite/tests/th/TH_tf2.hs
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 43c3e89b02..dda8274c5b 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -1,8 +1,3 @@
-# NOTICE TO DEVELOPERS
-# ~~~~~~~~~~~~~~~~~~~~
-# Adding a TemplateHaskell test?  If it only contains (non-quasi) quotes
-# and no splices, consider adding it to the quotes/ directory instead
-# of the th/ directory; this way, we can test it on the stage 1 compiler too!
 
 # This test needs to come before the setTestOpts calls below, as we want
 # to run it if compiler_profiled.
@@ -21,7 +16,9 @@ setTestOpts(when(compiler_profiled(), skip))
 test('TH_mkName', normal, compile, ['-v0'])
 test('TH_1tuple', normal, compile_fail, ['-v0'])
 
+test('TH_repE1', normal, compile, [''])
 test('TH_repE2', normal, compile_and_run, [''])
+test('TH_repE3', normal, compile, [''])
 test('TH_repPrim', normal, compile, ['-v0'])
 test('TH_repPrim2', normal, compile, ['-v0'])
 test('TH_repUnboxedTuples', normal, compile, ['-v0'])
@@ -70,6 +67,8 @@ test('TH_spliceD2',
 test('TH_reifyDecl1', normal, compile, ['-v0'])
 test('TH_reifyDecl2', normal, compile, ['-v0'])
 
+test('TH_reifyType1', normal, compile, [''])
+test('TH_reifyType2', normal, compile, [''])
 test('TH_reifyMkName', normal, compile, ['-v0'])
 
 test('TH_reifyInstances', normal, compile, ['-v0'])
@@ -100,6 +99,10 @@ test('TH_spliceExpr1', normal, compile, ['-v0'])
 test('TH_spliceE3', normal, compile, ['-v0'])
 test('TH_spliceE4', normal, compile_and_run, [''])
 
+test('TH_bracket1', normal, compile, [''])
+test('TH_bracket2', normal, compile, [''])
+test('TH_bracket3', normal, compile, [''])
+
 test('TH_class1', normal, compile, ['-v0'])
 test('TH_tuple1', normal, compile, ['-v0'])
 test('TH_genEx',
@@ -119,6 +122,8 @@ test('TH_exn2', normal, compile_fail, ['-v0'])
 test('TH_recover', normal, compile_and_run, [''])
 test('TH_dataD1', normal, compile_fail, ['-v0'])
 
+test('TH_ppr1', normal, compile_and_run, [''])
+
 test('TH_fail', normal, compile_fail, ['-v0'])
 test('TH_scopedTvs', normal, compile, ['-v0'])
 
@@ -128,10 +133,13 @@ test('TH_ghci1', normal, ghci_script, ['TH_ghci1.script'])
 
 test('TH_linePragma', normal, compile_fail, ['-v0'])
 
+test('TH_scope', normal, compile, [''])
+test('T2632', normal, compile, [''])
 test('T2700', normal, compile, ['-v0'])
 test('T2817', normal, compile, ['-v0'])
 test('T2713', normal, compile_fail, ['-v0'])
 test('T2674', normal, compile_fail, ['-v0'])
+test('T2931', normal, compile, ['-v0'])
 test('TH_emptycase', normal, compile, ['-v0'])
 
 test('T2386', extra_clean(['T2386_Lib.hi', 'T2386_Lib.o']),
@@ -144,6 +152,7 @@ test('T2685', extra_clean(['T2685a.hi','T2685a.o']),
 test('TH_sections', normal, compile, ['-v0'])
 
 test('TH_tf1', normal, compile, ['-v0'])
+test('TH_tf2', normal, compile, ['-v0'])
 test('TH_tf3', normal, compile, ['-v0'])
 
 test('TH_pragma', normal, compile, ['-v0 -dsuppress-uniques'])
@@ -158,6 +167,7 @@ test('TH_foreignCallingConventions', normal,
 
 test('T3395', normal, compile_fail, ['-v0'])
 test('T3467', normal, compile, [''])
+test('T3572', normal, compile_and_run, [''])
 test('T3100', normal, compile, ['-v0'])
 test('T3920', normal, compile_and_run, ['-v0'])
 
@@ -167,8 +177,10 @@ test('T3845', normal, compile, ['-v0'])
 test('T3899', extra_clean(['T3899a.hi','T3899a.o']),
               multimod_compile,
               ['T3899','-v0 -ddump-splices -dsuppress-uniques ' + config.ghc_th_way_flags])
+test('T4056', normal, compile, ['-v0'])
 test('T4188', normal, compile, ['-v0'])
 test('T4233', normal, compile, ['-v0'])
+test('T4169', normal, compile, ['-v0'])
 test('T1835', normal, compile_and_run, ['-v0'])
 
 test('TH_viewPatPrint', normal, compile_and_run, [''])
@@ -215,6 +227,7 @@ test('T5665', extra_clean(['T5665a.hi','T5665a.o']),
 test('T5700', extra_clean(['T5700a.hi','T5700a.o']),
               multimod_compile,
               ['T5700','-v0 -ddump-splices ' + config.ghc_th_way_flags])
+test('T5721', normal, compile, ['-v0'])
 
 test('TH_PromotedTuple', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
 test('TH_PromotedList', normal, compile, ['-v0'])
@@ -289,12 +302,15 @@ test('T8333',
      run_command,
      ['$MAKE -s --no-print-directory T8333'])
 
+test('T4170', normal, compile, ['-v0'])
 test('T4124', normal, compile, ['-v0'])
 test('T4128', normal, compile, ['-v0'])
+test('T6062', normal, compile, ['-v0'])
 test('T4364', normal, compile, ['-v0'])
 test('T8412', normal, compile_fail, ['-v0'])
 test('T7667', normal, compile, ['-v0'])
 test('T7667a', normal, compile_fail, ['-v0'])
+test('T8455', normal, compile, ['-v0'])
 test('T8499', normal, compile, ['-v0'])
 test('T7477', normal, compile, ['-v0'])
 test('T8507', normal, compile, ['-v0'])
@@ -306,6 +322,7 @@ test('T8577',
      extra_clean(['T8577a.hi', 'T8577a.o']),
      multimod_compile_fail,
      ['T8577', '-v0 ' + config.ghc_th_way_flags])
+test('T8633', normal, compile_and_run, [''])
 test('T8625', normal, ghci_script, ['T8625.script'])
 test('TH_StaticPointers',
      [ when(compiler_lt('ghc', '7.9'), skip) ],
@@ -314,6 +331,7 @@ test('TH_StaticPointers02',
      [ when(compiler_lt('ghc', '7.9'), skip) ],
      compile_fail, [''])
 test('T8759', normal, compile_fail, ['-v0'])
+test('T8759a', normal, compile_fail, ['-v0'])
 test('T7021',
      extra_clean(['T7021a.hi', 'T7021a.o']), multimod_compile, ['T7021','-v0'])
 test('T8807', normal, compile, ['-v0'])
@@ -336,6 +354,7 @@ test('T9209', normal, compile_fail, ['-v0'])
 test('T7484', normal, compile_fail, ['-v0'])
 test('T1476', normal, compile, ['-v0'])
 test('T1476b', normal, compile_fail, ['-v0'])
+test('T9824', normal, compile, ['-v0'])
 test('T8031', normal, compile, ['-v0'])
 test('T8624', normal, run_command, ['$MAKE -s --no-print-directory T8624'])
 test('TH_Lift', normal, compile, ['-v0'])
@@ -343,3 +362,5 @@ test('T10047', normal, ghci_script, ['T10047.script'])
 test('T10019', normal, ghci_script, ['T10019.script'])
 test('T10279', normal, compile_fail, ['-v0'])
 test('T10306', normal, compile, ['-v0'])
+
+test('TH_abstractFamily', normal, compile_fail, [''])