Separate constructors for typed and untyped brackets

Split HsBracket into HsTypedBracket and HsUntypedBracket.

Unfortunately, we still cannot get rid of

    instance XXTypedBracket GhcTc = HsTypedBracket GhcRn

despite no longer requiring it for typechecking, but rather because the
TH desugarer works on GhcRn rather than GhcTc (See GHC.HsToCore.Quote)

16 files changed, 260 insertions, 174 deletions

diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index b9c9c12415..5dfff39437 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -187,17 +187,6 @@ type instance HsDoRn (GhcPass _) = GhcRn
 
 -- ---------------------------------------------------------------------
 
-    -- See Note [Pending Splices]
-data HsBracketRn
-  = HsBracketRnTyped
-    (EpAnn [AddEpAnn])
-
-  | HsBracketRnUntyped
-    (EpAnn [AddEpAnn])
-    [PendingRnSplice]  -- Output of the renamer is the *original* renamed
-                       -- expression, plus
-                       -- _renamed_ splices to be type checked
-
 data HsBracketTc = HsBracketTc
   Type
   (Maybe QuoteWrapper) -- The wrapper to apply type and dictionary argument
@@ -207,9 +196,16 @@ data HsBracketTc = HsBracketTc
                        -- _typechecked_ splices to be
                        -- pasted back in by the desugarer
 
-type instance XBracket GhcPs = EpAnn [AddEpAnn]
-type instance XBracket GhcRn = HsBracketRn
-type instance XBracket GhcTc = HsBracketTc
+type instance XTypedBracket GhcPs = EpAnn [AddEpAnn]
+type instance XTypedBracket GhcRn = EpAnn [AddEpAnn]
+type instance XTypedBracket GhcTc = HsBracketTc
+type instance XUntypedBracket GhcPs = EpAnn [AddEpAnn]
+type instance XUntypedBracket GhcRn = (EpAnn [AddEpAnn], [PendingRnSplice])
+                       -- See Note [Pending Splices]
+                       -- Output of the renamer is the *original* renamed
+                       -- expression, plus
+                       -- _renamed_ splices to be type checked
+type instance XUntypedBracket GhcTc = HsBracketTc
 
 -- ---------------------------------------------------------------------
 
@@ -653,13 +649,19 @@ ppr_expr (ExprWithTySig _ expr sig)
 ppr_expr (ArithSeq _ _ info) = brackets (ppr info)
 
 ppr_expr (HsSpliceE _ s)         = pprSplice s
-ppr_expr (HsBracket b e)
+ppr_expr (HsTypedBracket b e)
   = case ghcPass @p of
-    GhcPs -> pprHsBracket e
+    GhcPs -> thTyBrackets (ppr e)
+    GhcRn -> thTyBrackets (ppr e)
+    GhcTc -> case b of
+      HsBracketTc _ty _wrap [] -> thTyBrackets (ppr e)
+      HsBracketTc _ty _wrap ps -> thTyBrackets (ppr e) $$ text "pending(tc)" <+> pprIfTc @p (ppr ps)
+ppr_expr (HsUntypedBracket b e)
+  = case ghcPass @p of
+    GhcPs -> ppr e
     GhcRn -> case b of
-      HsBracketRnTyped _ -> pprHsBracket e
-      HsBracketRnUntyped _ [] -> ppr e
-      HsBracketRnUntyped _ ps -> ppr e $$ text "pending(rn)" <+> ppr ps
+      (_, []) -> ppr e
+      (_, ps) -> ppr e $$ text "pending(rn)" <+> ppr ps
     GhcTc -> case b of
       HsBracketTc _ty _wrap [] -> ppr e
       HsBracketTc _ty _wrap ps -> ppr e $$ text "pending(tc)" <+> pprIfTc @p (ppr ps)
@@ -802,7 +804,8 @@ hsExprNeedsParens prec = go
     go (ArithSeq{})                   = False
     go (HsPragE{})                    = prec >= appPrec
     go (HsSpliceE{})                  = False
-    go (HsBracket{})                  = False
+    go (HsTypedBracket{})             = False
+    go (HsUntypedBracket{})           = False
     go (HsProc{})                     = prec > topPrec
     go (HsStatic{})                   = prec >= appPrec
     go (RecordCon{})                  = False
@@ -1665,12 +1668,12 @@ bracket code.  So for example
     [| f $(g x) |]
 looks like
 
-    HsBracket _ (HsApp (HsVar "f") (HsSpliceE _ (g x)))
+    HsUntypedBracket _ (HsApp (HsVar "f") (HsSpliceE _ (g x)))
 
 which the renamer rewrites to
 
-    HsBracket
-        (HsBracketRnUnTyped _ [PendingRnSplice UntypedExpSplice sn (g x)])
+    HsUntypedBracket
+        (_, [PendingRnSplice UntypedExpSplice sn (g x)])
         (HsApp (HsVar f) (HsSpliceE sn (g x)))
 
 * The 'sn' is the Name of the splice point, the SplicePointName
@@ -1777,59 +1780,71 @@ ppr_splice herald n e trail
 Note [Type-checking untyped brackets]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 When we type-check an untyped bracket, the actual bracket (the second argument
-of the HsBracket constructor in HsExpr) is kept in the renaming pass.
+of the HsUntypedBracket constructor in HsExpr) is kept in the renaming pass.
 
 Given that
 
   HsExpr p = ...
-    | HsBracket (XBracket p) (HsBracket p)
+    | HsUntypedBracket (XUntypedBracket p) (HsUntypedBracket p)
 
-When p = GhcPs we should have HsExpr GhcPs and HsBracket GhcPs
-When p = GhcRn we should have HsExpr GhcRn and HsBracket GhcRn
-However, when p = GhcRn we should have HsExpr GhcTc and HsBracket GhcRn
+When p = GhcPs we should have HsExpr GhcPs and HsUntypedBracket GhcPs
+When p = GhcRn we should have HsExpr GhcRn and HsUntypedBracket GhcRn
+However, when p = GhcTc we should have HsExpr GhcTc and HsUntypedBracket GhcRn
 
-To work around this, the HsBracket extension constructor (XBracket !(XXBracket p)),
-when p = GhcTc, is used to hold the needed HsBracket GhcRn
+To work around this, the HsUntypedBracket extension constructor (XUntypedBracket !(XXUntypedBracket p)),
+when p = GhcTc, is used to hold the needed HsUntypedBracket GhcRn
 
 Note that a typed bracket is just fine: you'll see in tcTypedBracket that
 _tc_expr is just thrown away. It will comfortably come to rest inside a TExpBr
 (of type HsBracket GhcTc).
 -}
 
-type instance XExpBr      (GhcPass _) = NoExtField
-type instance XPatBr      (GhcPass _) = NoExtField
-type instance XDecBrL     (GhcPass _) = NoExtField
-type instance XDecBrG     (GhcPass _) = NoExtField
-type instance XTypBr      (GhcPass _) = NoExtField
-type instance XVarBr      (GhcPass _) = NoExtField
-type instance XTExpBr     (GhcPass _) = NoExtField
-type instance XXBracket   GhcPs = DataConCantHappen
-type instance XXBracket   GhcRn = DataConCantHappen
-type instance XXBracket   GhcTc = HsBracket GhcRn   -- See Note [Type-checking untyped brackets]
+type instance XTExpBr        (GhcPass _) = NoExtField
+type instance XXTypedBracket GhcPs       = DataConCantHappen
+type instance XXTypedBracket GhcRn       = DataConCantHappen
+type instance XXTypedBracket GhcTc       = HsTypedBracket GhcRn     -- romes TODO: See Note [Desugaring typed brackets]
+
+type instance XExpBr           (GhcPass _) = NoExtField
+type instance XPatBr           (GhcPass _) = NoExtField
+type instance XDecBrL          (GhcPass _) = NoExtField
+type instance XDecBrG          (GhcPass _) = NoExtField
+type instance XTypBr           (GhcPass _) = NoExtField
+type instance XVarBr           (GhcPass _) = NoExtField
+type instance XXUntypedBracket GhcPs       = DataConCantHappen
+type instance XXUntypedBracket GhcRn       = DataConCantHappen
+type instance XXUntypedBracket GhcTc       = HsUntypedBracket GhcRn -- See Note [Type-checking untyped brackets]
 
 instance OutputableBndrId p
-          => Outputable (HsBracket (GhcPass p)) where
-  ppr = pprHsBracket
-
-
-pprHsBracket :: forall p. (OutputableBndrId p)
-             => HsBracket (GhcPass p) -> SDoc
-pprHsBracket (ExpBr _ e)   = thBrackets empty (ppr e)
-pprHsBracket (PatBr _ p)   = thBrackets (char 'p') (ppr p)
-pprHsBracket (DecBrG _ gp) = thBrackets (char 'd') (ppr gp)
-pprHsBracket (DecBrL _ ds) = thBrackets (char 'd') (vcat (map ppr ds))
-pprHsBracket (TypBr _ t)   = thBrackets (char 't') (ppr t)
-pprHsBracket (VarBr _ True n)
-  = char '\'' <> pprPrefixOcc (unLoc n)
-pprHsBracket (VarBr _ False n)
-  = text "''" <> pprPrefixOcc (unLoc n)
-pprHsBracket (TExpBr _ e)  = thTyBrackets (ppr e)
-pprHsBracket (XBracket b)  = case ghcPass @p of
+          => Outputable (HsTypedBracket (GhcPass p)) where
+  ppr (TExpBr _ e)      = thTyBrackets (ppr e)
+  ppr (XTypedBracket b) = case ghcPass @p of
 #if __GLASGOW_HASKELL__ <= 900
-    GhcPs -> dataConCantHappen b
-    GhcRn -> dataConCantHappen b
+      GhcPs -> dataConCantHappen b
+      GhcRn -> dataConCantHappen b
 #endif
-    GhcTc -> pprHsBracket b
+      GhcTc | (TExpBr _ e) <- b -> thTyBrackets (ppr e)
+
+instance OutputableBndrId p
+          => Outputable (HsUntypedBracket (GhcPass p)) where
+  ppr = pprHsUntypedBracket
+    where
+      pprHsUntypedBracket :: forall p. (OutputableBndrId p)
+                   => HsUntypedBracket (GhcPass p) -> SDoc
+      pprHsUntypedBracket (ExpBr _ e)   = thBrackets empty (ppr e)
+      pprHsUntypedBracket (PatBr _ p)   = thBrackets (char 'p') (ppr p)
+      pprHsUntypedBracket (DecBrG _ gp) = thBrackets (char 'd') (ppr gp)
+      pprHsUntypedBracket (DecBrL _ ds) = thBrackets (char 'd') (vcat (map ppr ds))
+      pprHsUntypedBracket (TypBr _ t)   = thBrackets (char 't') (ppr t)
+      pprHsUntypedBracket (VarBr _ True n)
+        = char '\'' <> pprPrefixOcc (unLoc n)
+      pprHsUntypedBracket (VarBr _ False n)
+        = text "''" <> pprPrefixOcc (unLoc n)
+      pprHsUntypedBracket (XUntypedBracket b)  = case ghcPass @p of
+      #if __GLASGOW_HASKELL__ <= 900
+          GhcPs -> dataConCantHappen b
+          GhcRn -> dataConCantHappen b
+      #endif
+          GhcTc -> pprHsUntypedBracket b
 
 thBrackets :: SDoc -> SDoc -> SDoc
 thBrackets pp_kind pp_body = char '[' <> pp_kind <> vbar <+>
diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
index f93df4ac67..fbfe0ea0ef 100644
--- a/compiler/GHC/Hs/Instances.hs
+++ b/compiler/GHC/Hs/Instances.hs
@@ -383,12 +383,15 @@ deriving instance Data (HsSplicedThing GhcPs)
 deriving instance Data (HsSplicedThing GhcRn)
 deriving instance Data (HsSplicedThing GhcTc)
 
--- deriving instance (DataIdLR p p) => Data (HsBracket p)
-deriving instance Data (HsBracket GhcPs)
-deriving instance Data (HsBracket GhcRn)
-deriving instance Data (HsBracket GhcTc)
-
-deriving instance Data HsBracketRn
+-- deriving instance (DataIdLR p p) => Data (HsTypedBracket p)
+deriving instance Data (HsTypedBracket GhcPs)
+deriving instance Data (HsTypedBracket GhcRn)
+deriving instance Data (HsTypedBracket GhcTc)
+
+-- deriving instance (DataIdLR p p) => Data (HsUntypedBracket p)
+deriving instance Data (HsUntypedBracket GhcPs)
+deriving instance Data (HsUntypedBracket GhcRn)
+deriving instance Data (HsUntypedBracket GhcTc)
 
 deriving instance Data HsBracketTc
 
diff --git a/compiler/GHC/Hs/Syn/Type.hs b/compiler/GHC/Hs/Syn/Type.hs
index a57cd80145..5cf368027d 100644
--- a/compiler/GHC/Hs/Syn/Type.hs
+++ b/compiler/GHC/Hs/Syn/Type.hs
@@ -129,7 +129,8 @@ hsExprType (ArithSeq _ mb_overloaded_op asi) = case mb_overloaded_op of
   Nothing -> asi_ty
   where
     asi_ty = arithSeqInfoType asi
-hsExprType (HsBracket (HsBracketTc ty _wrap _pending) _) = ty
+hsExprType (HsTypedBracket   (HsBracketTc ty _wrap _pending) _) = ty
+hsExprType (HsUntypedBracket (HsBracketTc ty _wrap _pending) _) = ty
 hsExprType e@(HsSpliceE{}) = pprPanic "hsExprType: Unexpected HsSpliceE"
                                       (ppr e)
                                       -- Typed splices should have been eliminated during zonking, but we
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index 9fcfd9a81e..e1e8489fe1 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -638,7 +638,8 @@ addTickHsExpr (ArithSeq ty wit arith_seq) =
 
 addTickHsExpr (HsPragE x p e) =
         liftM (HsPragE x p) (addTickLHsExpr e)
-addTickHsExpr e@(HsBracket     {})   = return e
+addTickHsExpr e@(HsTypedBracket {})  = return e
+addTickHsExpr e@(HsUntypedBracket{}) = return e
 addTickHsExpr e@(HsSpliceE  {})      = return e
 addTickHsExpr e@(HsGetField {})      = return e
 addTickHsExpr e@(HsProjection {})    = return e
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 1691db72a9..d52e9f997b 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -747,8 +747,12 @@ Thus, we pass @r@ as the scrutinee expression to @matchWrapper@ above.
 
 -- Template Haskell stuff
 
-dsExpr (HsBracket (HsBracketTc _ hs_wrapper ps) (XBracket x)) = dsBracket hs_wrapper x ps -- See Note [Type-checking untyped brackets] in GHC.Hs.Expr
-dsExpr (HsBracket (HsBracketTc _ _ ps) _) = pprPanic "dsExpr:bracket" (ppr ps)
+dsExpr (HsTypedBracket (HsBracketTc _ hs_wrapper ps) (XTypedBracket x)) = dsTypedBracket hs_wrapper x ps
+                                -- ^ See Note [Desugaring typed brackets] in GHC.Hs.Expr on why XTypedBracket -- romes TODO:
+dsExpr (HsTypedBracket (HsBracketTc _ _ ps) _) = pprPanic "dsExpr:typed_bracket" (ppr ps)
+dsExpr (HsUntypedBracket (HsBracketTc _ hs_wrapper ps) (XUntypedBracket x)) = dsUntypedBracket hs_wrapper x ps
+                                -- ^ See Note [Type-checking untyped brackets] in GHC.Hs.Expr on why XUntypedBracket
+dsExpr (HsUntypedBracket (HsBracketTc _ _ ps) _) = pprPanic "dsExpr:untyped_bracket" (ppr ps)
 dsExpr (HsSpliceE _ s)                    = pprPanic "dsExpr:splice" (ppr s)
 
 -- Arrow notation extension
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 6c8b113dec..b4767dc679 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -27,7 +27,7 @@
 -- a Royal Pain (triggers other recompilation).
 -----------------------------------------------------------------------------
 
-module GHC.HsToCore.Quote( dsBracket ) where
+module GHC.HsToCore.Quote( dsTypedBracket, dsUntypedBracket ) where
 
 import GHC.Prelude
 import GHC.Platform
@@ -157,37 +157,52 @@ getPlatform :: MetaM Platform
 getPlatform = targetPlatform <$> getDynFlags
 
 -----------------------------------------------------------------------------
-dsBracket :: Maybe QuoteWrapper -- ^ This is Nothing only when we are dealing with a VarBr
-          -> HsBracket GhcRn
-          -> [PendingTcSplice]
-          -> DsM CoreExpr
+dsTypedBracket   :: Maybe QuoteWrapper
+                 -> HsTypedBracket GhcRn
+                 -> [PendingTcSplice]
+                 -> DsM CoreExpr
+dsTypedBracket wrap (TExpBr _ exp) splices
+  = runOverloaded $ do { MkC e1 <- repLE exp ; return e1 }
+  where
+    -- ROMES: TODO: factoring this method out requires many imports for its explicit type, is it worth it?
+    runOverloaded act = do
+      -- In the overloaded case we have to get given a wrapper, it is just
+      -- for variable quotations that there is no wrapper, because they
+      -- have a simple type.
+      mw <- mkMetaWrappers (expectJust "runOverloaded" wrap)
+      runReaderT (mapReaderT (dsExtendMetaEnv (new_bit splices)) act) mw
+
+dsUntypedBracket :: Maybe QuoteWrapper -- ^ This is Nothing only when we are dealing with a VarBr
+                 -> HsUntypedBracket GhcRn
+                 -> [PendingTcSplice]
+                 -> DsM CoreExpr
 -- See Note [Desugaring Brackets]
 -- Returns a CoreExpr of type (M TH.Exp)
 -- The quoted thing is parameterised over Name, even though it has
 -- been type checked.  We don't want all those type decorations!
 
-dsBracket wrap brack splices
+dsUntypedBracket wrap brack splices
   = do_brack brack
-
   where
+    -- ROMES: TODO: factoring this method out requires many imports for its explicit type, is it worth it?
     runOverloaded act = do
       -- In the overloaded case we have to get given a wrapper, it is just
       -- for variable quotations that there is no wrapper, because they
       -- have a simple type.
       mw <- mkMetaWrappers (expectJust "runOverloaded" wrap)
-      runReaderT (mapReaderT (dsExtendMetaEnv new_bit) act) mw
-
-
-    new_bit = mkNameEnv [(n, DsSplice (unLoc e))
-                        | PendingTcSplice n e <- splices]
+      runReaderT (mapReaderT (dsExtendMetaEnv (new_bit splices)) act) mw
 
     do_brack (VarBr _ _ n) = do { MkC e1  <- lookupOccDsM (unLoc n) ; return e1 }
     do_brack (ExpBr _ e)   = runOverloaded $ do { MkC e1  <- repLE e     ; return e1 }
     do_brack (PatBr _ p)   = runOverloaded $ do { MkC p1  <- repTopP p   ; return p1 }
     do_brack (TypBr _ t)   = runOverloaded $ do { MkC t1  <- repLTy t    ; return t1 }
     do_brack (DecBrG _ gp) = runOverloaded $ do { MkC ds1 <- repTopDs gp ; return ds1 }
-    do_brack (DecBrL {})   = panic "dsBracket: unexpected DecBrL"
-    do_brack (TExpBr _ e)  = runOverloaded $ do { MkC e1  <- repLE e     ; return e1 }
+    do_brack (DecBrL {})   = panic "dsUntypedBracket: unexpected DecBrL"
+
+new_bit :: [PendingTcSplice] -> NameEnv DsMetaVal
+new_bit splices = mkNameEnv [(n, DsSplice (unLoc e))
+                    | PendingTcSplice n e <- splices]
+
 
 {-
 Note [Desugaring Brackets]
@@ -1636,7 +1651,8 @@ repE (XExpr (HsExpanded orig_expr ds_expr))
          then repE ds_expr
          else repE orig_expr }
 repE e@(HsPragE _ (HsPragSCC {}) _) = notHandled (ThCostCentres e)
-repE e@(HsBracket{}) = notHandled (ThExpressionForm e)
+repE e@(HsTypedBracket{})   = notHandled (ThExpressionForm e)
+repE e@(HsUntypedBracket{}) = notHandled (ThExpressionForm e)
 repE e@(HsProc{}) = notHandled (ThExpressionForm e)
 
 {- Note [Quotation and rebindable syntax]
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 3aba40407b..c825c46a01 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -1183,12 +1183,16 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where
       HsStatic _ expr ->
         [ toHie expr
         ]
-      HsBracket xbracket b -> case hiePass @p of
-        HieRn -> case xbracket of
-          HsBracketRnTyped _ ->
+      HsTypedBracket xbracket b -> case hiePass @p of
+        HieRn | _ <- xbracket ->
             [ toHie b
             ]
-          HsBracketRnUntyped _ p ->
+        HieTc | HsBracketTc _ _ p <- xbracket ->
+          [ toHie b
+          , toHie p
+          ]
+      HsUntypedBracket xbracket b -> case hiePass @p of
+        HieRn | (_, p) <- xbracket ->
             [ toHie b
             , toHie p
             ]
@@ -1855,7 +1859,10 @@ instance ToHie (LocatedA (SpliceDecl GhcRn)) where
         [ toHie splice
         ]
 
-instance ToHie (HsBracket a) where
+instance ToHie (HsTypedBracket a) where
+  toHie _ = pure []
+
+instance ToHie (HsUntypedBracket a) where
   toHie _ = pure []
 
 instance ToHie PendingRnSplice where
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 24ef753453..3a016e00de 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2917,26 +2917,26 @@ aexp2   :: { ECP }
         | splice_untyped { ECP $ pvA $ mkHsSplicePV $1 }
         | splice_typed   { ecpFromExp $ mapLoc (HsSpliceE noAnn) (reLocA $1) }
 
-        | SIMPLEQUOTE  qvar     {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True  $2)) }
-        | SIMPLEQUOTE  qcon     {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True  $2)) }
-        | TH_TY_QUOTE tyvar     {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsBracket (EpAnn (glR $1) [mj AnnThTyQuote $1  ] cs) (VarBr noExtField False $2)) }
-        | TH_TY_QUOTE gtycon    {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsBracket (EpAnn (glR $1) [mj AnnThTyQuote $1  ] cs) (VarBr noExtField False $2)) }
+        | SIMPLEQUOTE  qvar     {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True  $2)) }
+        | SIMPLEQUOTE  qcon     {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True  $2)) }
+        | TH_TY_QUOTE tyvar     {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnThTyQuote $1  ] cs) (VarBr noExtField False $2)) }
+        | TH_TY_QUOTE gtycon    {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnThTyQuote $1  ] cs) (VarBr noExtField False $2)) }
         -- See Note [%shift: aexp2 -> TH_TY_QUOTE]
         | TH_TY_QUOTE %shift    {% reportEmptyDoubleQuotes (getLoc $1) }
         | '[|' exp '|]'       {% runPV (unECP $2) >>= \ $2 ->
                                  fmap ecpFromExp $
-                                 acsA (\cs -> sLL $1 $> $ HsBracket (EpAnn (glR $1) (if (hasE $1) then [mj AnnOpenE $1, mu AnnCloseQ $3]
+                                 acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glR $1) (if (hasE $1) then [mj AnnOpenE $1, mu AnnCloseQ $3]
                                                                                          else [mu AnnOpenEQ $1,mu AnnCloseQ $3]) cs) (ExpBr noExtField $2)) }
         | '[||' exp '||]'     {% runPV (unECP $2) >>= \ $2 ->
                                  fmap ecpFromExp $
-                                 acsA (\cs -> sLL $1 $> $ HsBracket (EpAnn (glR $1) (if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) cs) (TExpBr noExtField $2)) }
+                                 acsA (\cs -> sLL $1 $> $ HsTypedBracket (EpAnn (glR $1) (if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) cs) (TExpBr noExtField $2)) }
         | '[t|' ktype '|]'    {% fmap ecpFromExp $
-                                 acsA (\cs -> sLL $1 $> $ HsBracket (EpAnn (glR $1) [mo $1,mu AnnCloseQ $3] cs) (TypBr noExtField $2)) }
+                                 acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glR $1) [mo $1,mu AnnCloseQ $3] cs) (TypBr noExtField $2)) }
         | '[p|' infixexp '|]' {% (checkPattern <=< runPV) (unECP $2) >>= \p ->
                                       fmap ecpFromExp $
-                                      acsA (\cs -> sLL $1 $> $ HsBracket (EpAnn (glR $1) [mo $1,mu AnnCloseQ $3] cs) (PatBr noExtField p)) }
+                                      acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glR $1) [mo $1,mu AnnCloseQ $3] cs) (PatBr noExtField p)) }
         | '[d|' cvtopbody '|]' {% fmap ecpFromExp $
-                                  acsA (\cs -> sLL $1 $> $ HsBracket (EpAnn (glR $1) (mo $1:mu AnnCloseQ $3:fst $2) cs) (DecBrL noExtField (snd $2))) }
+                                  acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glR $1) (mo $1:mu AnnCloseQ $3:fst $2) cs) (DecBrL noExtField (snd $2))) }
         | quasiquote          { ECP $ pvA $ mkHsSplicePV $1 }
 
         -- arrow notation extension
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index 6c7a55da1f..f1cb766077 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -47,7 +47,7 @@ import GHC.Rename.Utils ( bindLocalNamesFV, checkDupNames
                         , genHsVar, genLHsVar, genHsApp, genHsApps
                         , genAppType )
 import GHC.Rename.Unbound ( reportUnboundName )
-import GHC.Rename.Splice  ( rnBracket, rnSpliceExpr, checkThLocalName )
+import GHC.Rename.Splice  ( rnTypedBracket, rnUntypedBracket, rnSpliceExpr, checkThLocalName )
 import GHC.Rename.HsType
 import GHC.Rename.Pat
 import GHC.Driver.Session
@@ -337,7 +337,8 @@ rnExpr (HsProjection _ fs)
 
 ------------------------------------------
 -- Template Haskell extensions
-rnExpr e@(HsBracket _ br_body) = rnBracket e br_body
+rnExpr e@(HsTypedBracket _ br_body)   = rnTypedBracket e br_body
+rnExpr e@(HsUntypedBracket _ br_body) = rnUntypedBracket e br_body
 
 rnExpr (HsSpliceE _ splice) = rnSpliceExpr splice
 
diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs
index aae22dfd93..8993442711 100644
--- a/compiler/GHC/Rename/Splice.hs
+++ b/compiler/GHC/Rename/Splice.hs
@@ -6,7 +6,7 @@
 module GHC.Rename.Splice (
         rnTopSpliceDecls,
         rnSpliceType, rnSpliceExpr, rnSplicePat, rnSpliceDecl,
-        rnBracket,
+        rnTypedBracket, rnUntypedBracket,
         checkThLocalName
         , traceSplice, SpliceInfo(..)
   ) where
@@ -73,9 +73,9 @@ import qualified GHC.LanguageExtensions as LangExt
 ************************************************************************
 -}
 
-rnBracket :: HsExpr GhcPs -> HsBracket GhcPs -> RnM (HsExpr GhcRn, FreeVars)
-rnBracket e br_body
-  = addErrCtxt (quotationCtxtDoc br_body) $
+rnTypedBracket :: HsExpr GhcPs -> HsTypedBracket GhcPs -> RnM (HsExpr GhcRn, FreeVars)
+rnTypedBracket e (TExpBr ext br_body)
+  = addErrCtxt (typedQuotationCtxtDoc br_body) $
     do { -- Check that -XTemplateHaskellQuotes is enabled and available
          thQuotesEnabled <- xoptM LangExt.TemplateHaskellQuotes
        ; unless thQuotesEnabled $
@@ -87,13 +87,11 @@ rnBracket e br_body
          -- Check for nested brackets
        ; cur_stage <- getStage
        ; case cur_stage of
-           { Splice Typed   -> checkTc (isTypedBracket br_body)
-                                       illegalUntypedBracket
-           ; Splice Untyped -> checkTc (not (isTypedBracket br_body))
-                                       illegalTypedBracket
+           { Splice Typed   -> return ()
+           ; Splice Untyped -> failWithTc illegalTypedBracket
            ; RunSplice _    ->
                -- See Note [RunSplice ThLevel] in GHC.Tc.Types.
-               pprPanic "rnBracket: Renaming bracket when running a splice"
+               pprPanic "rnTypedBracket: Renaming typed bracket when running a splice"
                         (ppr e)
            ; Comp           -> return ()
            ; Brack {}       -> failWithTc illegalBracket
@@ -102,26 +100,54 @@ rnBracket e br_body
          -- Brackets are desugared to code that mentions the TH package
        ; recordThUse
 
-       ; case isTypedBracket br_body of
-            True  -> do { traceRn "Renaming typed TH bracket" empty
-                        ; (body', fvs_e) <-
-                          setStage (Brack cur_stage RnPendingTyped) $
-                                   rn_bracket cur_stage br_body
-                        ; return (HsBracket (HsBracketRnTyped noAnn) body', fvs_e) }
-
-            False -> do { traceRn "Renaming untyped TH bracket" empty
-                        ; ps_var <- newMutVar []
-                        ; (body', fvs_e) <-
-                          -- See Note [Rebindable syntax and Template Haskell]
-                          unsetXOptM LangExt.RebindableSyntax $
-                          setStage (Brack cur_stage (RnPendingUntyped ps_var)) $
-                                   rn_bracket cur_stage br_body
-                        ; pendings <- readMutVar ps_var
-                        ; return (HsBracket (HsBracketRnUntyped noAnn pendings) body', fvs_e) }
+       ; traceRn "Renaming typed TH bracket" empty
+       ; (body', fvs_e) <- setStage (Brack cur_stage RnPendingTyped) $ rnLExpr br_body
+
+       ; return (HsTypedBracket noAnn (TExpBr ext body'), fvs_e)
+
        }
 
-rn_bracket :: ThStage -> HsBracket GhcPs -> RnM (HsBracket GhcRn, FreeVars)
-rn_bracket outer_stage br@(VarBr x flg rdr_name)
+rnUntypedBracket :: HsExpr GhcPs -> HsUntypedBracket GhcPs -> RnM (HsExpr GhcRn, FreeVars)
+rnUntypedBracket e br_body
+  = addErrCtxt (untypedQuotationCtxtDoc br_body) $
+    do { -- Check that -XTemplateHaskellQuotes is enabled and available
+         thQuotesEnabled <- xoptM LangExt.TemplateHaskellQuotes
+       ; unless thQuotesEnabled $
+           failWith ( TcRnUnknownMessage $ mkPlainError noHints $ 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 Typed   -> failWithTc illegalUntypedBracket
+           ; Splice Untyped -> return ()
+           ; RunSplice _    ->
+               -- See Note [RunSplice ThLevel] in GHC.Tc.Types.
+               pprPanic "rnUntypedBracket: Renaming untyped bracket when running a splice"
+                        (ppr e)
+           ; Comp           -> return ()
+           ; Brack {}       -> failWithTc illegalBracket
+           }
+
+         -- Brackets are desugared to code that mentions the TH package
+       ; recordThUse
+
+       ; traceRn "Renaming untyped TH bracket" empty
+       ; ps_var <- newMutVar []
+       ; (body', fvs_e) <-
+         -- See Note [Rebindable syntax and Template Haskell]
+         unsetXOptM LangExt.RebindableSyntax $
+         setStage (Brack cur_stage (RnPendingUntyped ps_var)) $
+                  rn_utbracket cur_stage br_body
+       ; pendings <- readMutVar ps_var
+       ; return (HsUntypedBracket (noAnn, pendings) body', fvs_e)
+
+       }
+
+rn_utbracket :: ThStage -> HsUntypedBracket GhcPs -> RnM (HsUntypedBracket GhcRn, FreeVars)
+rn_utbracket outer_stage br@(VarBr x flg rdr_name)
   = do { name <- lookupOccRn (unLoc rdr_name)
        ; check_namespace flg name
        ; this_mod <- getModule
@@ -137,7 +163,7 @@ rn_bracket outer_stage br@(VarBr x flg rdr_name)
                              | isTopLevel top_lvl
                              -> when (isExternalName name) (keepAlive name)
                              | otherwise
-                             -> do { traceRn "rn_bracket VarBr"
+                             -> do { traceRn "rn_utbracket VarBr"
                                       (ppr name <+> ppr bind_lvl
                                                 <+> ppr outer_stage)
                                    ; checkTc (thLevel outer_stage + 1 == bind_lvl)
@@ -146,16 +172,16 @@ rn_bracket outer_stage br@(VarBr x flg rdr_name)
                     }
        ; return (VarBr x flg (noLocA name), unitFV name) }
 
-rn_bracket _ (ExpBr x e) = do { (e', fvs) <- rnLExpr e
-                            ; return (ExpBr x e', fvs) }
+rn_utbracket _ (ExpBr x e) = do { (e', fvs) <- rnLExpr e
+                                ; return (ExpBr x e', fvs) }
 
-rn_bracket _ (PatBr x p)
+rn_utbracket _ (PatBr x p)
   = rnPat ThPatQuote p $ \ p' -> return (PatBr x p', emptyFVs)
 
-rn_bracket _ (TypBr x t) = do { (t', fvs) <- rnLHsType TypBrCtx t
-                              ; return (TypBr x t', fvs) }
+rn_utbracket _ (TypBr x t) = do { (t', fvs) <- rnLHsType TypBrCtx t
+                                ; return (TypBr x t', fvs) }
 
-rn_bracket _ (DecBrL x decls)
+rn_utbracket _ (DecBrL x decls)
   = do { group <- groupDecls decls
        ; gbl_env  <- getGblEnv
        ; let new_gbl_env = gbl_env { tcg_dus = emptyDUs }
@@ -165,7 +191,7 @@ rn_bracket _ (DecBrL x decls)
                               rnSrcDecls group
 
               -- Discard the tcg_env; it contains only extra info about fixity
-        ; traceRn "rn_bracket dec" (ppr (tcg_dus tcg_env) $$
+        ; traceRn "rn_utbracket dec" (ppr (tcg_dus tcg_env) $$
                    ppr (duUses (tcg_dus tcg_env)))
         ; return (DecBrG x group', duUses (tcg_dus tcg_env)) }
   where
@@ -181,10 +207,8 @@ rn_bracket _ (DecBrL x decls)
                   }
            }}
 
-rn_bracket _ (DecBrG {}) = panic "rn_bracket: unexpected DecBrG"
+rn_utbracket _ (DecBrG {}) = panic "rn_ut_bracket: unexpected DecBrG"
 
-rn_bracket _ (TExpBr x e) = do { (e', fvs) <- rnLExpr e
-                               ; return (TExpBr x e', fvs) }
 
 -- | Ensure that we are not using a term-level name in a type-level namespace
 -- or vice-versa. Throws a 'TcRnIncorrectNameSpace' error if there is a problem.
@@ -195,8 +219,13 @@ check_namespace is_single_tick nm
   where
     ns = nameNameSpace nm
 
-quotationCtxtDoc :: HsBracket GhcPs -> SDoc
-quotationCtxtDoc br_body
+typedQuotationCtxtDoc :: LHsExpr GhcPs -> SDoc
+typedQuotationCtxtDoc br_body
+  = hang (text "In the Template Haskell typed quotation")
+         2 (thTyBrackets . ppr $ br_body)
+
+untypedQuotationCtxtDoc :: HsUntypedBracket GhcPs -> SDoc
+untypedQuotationCtxtDoc br_body
   = hang (text "In the Template Haskell quotation")
          2 (ppr br_body)
 
@@ -213,7 +242,7 @@ illegalUntypedBracket :: TcRnMessage
 illegalUntypedBracket = TcRnUnknownMessage $ mkPlainError noHints $
     text "Untyped brackets may only appear in untyped splices."
 
-quotedNameStageErr :: HsBracket GhcPs -> TcRnMessage
+quotedNameStageErr :: HsUntypedBracket GhcPs -> TcRnMessage
 quotedNameStageErr br
   = TcRnUnknownMessage $ mkPlainError noHints $
     sep [ text "Stage error: the non-top-level quoted name" <+> ppr br
diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs
index d61ad20707..526c18706a 100644
--- a/compiler/GHC/Tc/Deriv/Generate.hs
+++ b/compiler/GHC/Tc/Deriv/Generate.hs
@@ -1630,12 +1630,12 @@ gen_Lift_binds loc (DerivInstTys{ dit_rep_tc = tycon
   (listToBag [lift_bind, liftTyped_bind], emptyBag)
   where
     lift_bind      = mkFunBindEC 1 loc lift_RDR (nlHsApp pure_Expr)
-                                 (map (pats_etc mk_exp mk_usplice liftName) data_cons)
+                                 (map (pats_etc mk_untyped_bracket mk_usplice liftName) data_cons)
     liftTyped_bind = mkFunBindEC 1 loc liftTyped_RDR (nlHsApp unsafeCodeCoerce_Expr . nlHsApp pure_Expr)
-                                 (map (pats_etc mk_texp mk_tsplice liftTypedName) data_cons)
+                                 (map (pats_etc mk_typed_bracket mk_tsplice liftTypedName) data_cons)
 
-    mk_exp = ExpBr noExtField
-    mk_texp = TExpBr noExtField
+    mk_untyped_bracket = HsUntypedBracket noAnn . ExpBr noExtField
+    mk_typed_bracket = HsTypedBracket noAnn . TExpBr noExtField
 
     mk_usplice = HsUntypedSplice EpAnnNotUsed DollarSplice
     mk_tsplice = HsTypedSplice EpAnnNotUsed DollarSplice
@@ -1648,7 +1648,7 @@ gen_Lift_binds loc (DerivInstTys{ dit_rep_tc = tycon
             data_con_RDR = getRdrName data_con
             con_arity    = dataConSourceArity data_con
             as_needed    = take con_arity as_RDRs
-            lift_Expr    = noLocA (HsBracket noAnn (mk_bracket br_body))
+            lift_Expr    = noLocA (mk_bracket br_body)
             br_body      = nlHsApps (Exact (dataConName data_con))
                                     (map lift_var as_needed)
 
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index 6dadf6286c..93bbdaafa6 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -861,9 +861,8 @@ tcExpr (HsSpliceE _ (HsSpliced _ mod_finalizers (HsSplicedExpr expr)))
   = do addModFinalizersWithLclEnv mod_finalizers
        tcExpr expr res_ty
 tcExpr (HsSpliceE _ splice)          res_ty = tcSpliceExpr splice res_ty
-tcExpr e@(HsBracket brack body)           res_ty = case brack of
-  HsBracketRnTyped _     -> tcTypedBracket e body res_ty
-  HsBracketRnUntyped _ ps -> tcUntypedBracket e body ps res_ty
+tcExpr e@(HsTypedBracket _ body) res_ty = tcTypedBracket e body res_ty
+tcExpr e@(HsUntypedBracket (_, ps) body) res_ty = tcUntypedBracket e body ps res_ty
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index 5acffaca7d..09b5e070ad 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -163,8 +163,8 @@ import Data.Proxy    ( Proxy (..) )
 ************************************************************************
 -}
 
-tcTypedBracket   :: HsExpr GhcRn -> HsBracket GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
-tcUntypedBracket :: HsExpr GhcRn -> HsBracket GhcRn -> [PendingRnSplice] -> ExpRhoType
+tcTypedBracket   :: HsExpr GhcRn -> HsTypedBracket GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
+tcUntypedBracket :: HsExpr GhcRn -> HsUntypedBracket GhcRn -> [PendingRnSplice] -> ExpRhoType
                  -> TcM (HsExpr GhcTc)
 tcSpliceExpr     :: HsSplice GhcRn  -> ExpRhoType -> TcM (HsExpr GhcTc)
         -- None of these functions add constraints to the LIE
@@ -184,9 +184,8 @@ runAnnotation     :: CoreAnnTarget -> LHsExpr GhcRn -> TcM Annotation
 -}
 
 -- See Note [How brackets and nested splices are handled]
--- tcTypedBracket :: HsBracket Name -> TcRhoType -> TcM (HsExpr TcId)
-tcTypedBracket rn_expr brack@(TExpBr _ expr) res_ty
-  = addErrCtxt (quotationCtxtDoc brack) $
+tcTypedBracket rn_expr e@(TExpBr ext expr) res_ty
+  = addErrCtxt (quotationCtxtDoc e) $
     do { cur_stage <- getStage
        ; ps_ref <- newMutVar []
        ; lie_var <- getConstraintVar   -- Any constraints arising from nested splices
@@ -213,16 +212,13 @@ tcTypedBracket rn_expr brack@(TExpBr _ expr) res_ty
        ; ps' <- readMutVar ps_ref
        ; codeco <- tcLookupId unsafeCodeCoerceName
        ; bracket_ty <- mkAppTy m_var <$> tcMetaTy expTyConName
-       ; tcWrapResultO (Shouldn'tHappenOrigin "TExpBr")
+       ; tcWrapResultO (Shouldn'tHappenOrigin "TExpBr") -- romes TODO: What is Shouldn'tHappenOrigin? Is this still accurate?
                        rn_expr
                        (unLoc (mkHsApp (mkLHsWrap (applyQuoteWrapper wrapper)
                                                   (nlHsTyApp codeco [rep, expr_ty]))
-                                      (noLocA (HsBracket (HsBracketTc bracket_ty (Just wrapper) ps') (XBracket brack)))))
+                                      (noLocA (HsTypedBracket (HsBracketTc bracket_ty (Just wrapper) ps') (XTypedBracket (TExpBr ext expr))))))
                        meta_ty res_ty }
-tcTypedBracket _ other_brack _
-  = pprPanic "tcTypedBracket" (ppr other_brack)
 
--- tcUntypedBracket :: HsBracket Name -> [PendingRnSplice] -> ExpRhoType -> TcM (HsExpr TcId)
 -- See Note [Typechecking Overloaded Quotes]
 tcUntypedBracket rn_expr brack ps res_ty
   = do { traceTc "tc_bracket untyped" (ppr brack $$ ppr ps)
@@ -246,7 +242,7 @@ tcUntypedBracket rn_expr brack ps res_ty
        -- Unify the overall type of the bracket with the expected result
        -- type
        ; tcWrapResultO BracketOrigin rn_expr
-            (HsBracket (HsBracketTc expected_type brack_info ps') (XBracket brack))
+            (HsUntypedBracket (HsBracketTc expected_type brack_info ps') (XUntypedBracket brack))
             expected_type res_ty
 
        }
@@ -268,7 +264,7 @@ emitQuoteWanted m_var =  do
 -- | Compute the expected type of a quotation, and also the QuoteWrapper in
 -- the case where it is an overloaded quotation. All quotation forms are
 -- overloaded aprt from Variable quotations ('foo)
-brackTy :: HsBracket GhcRn -> TcM (Maybe QuoteWrapper, Type)
+brackTy :: HsUntypedBracket GhcRn -> TcM (Maybe QuoteWrapper, Type)
 brackTy b =
   let mkTy n = do
         -- New polymorphic type variable for the bracket
@@ -291,7 +287,6 @@ brackTy b =
     (DecBrG {}) -> mkTy decsTyConName -- Result type is m [Dec]
     (PatBr {})  -> mkTy patTyConName  -- Result type is m Pat
     (DecBrL {}) -> panic "tcBrackTy: Unexpected DecBrL"
-    (TExpBr {}) -> panic "tcUntypedBracket: Unexpected TExpBr"
 
 ---------------
 -- | Typechecking a pending splice from a untyped bracket
@@ -329,7 +324,7 @@ tcTExpTy m_ty exp_ty
              , text "The type of a Typed Template Haskell expression must" <+>
                text "not have any quantification." ]
 
-quotationCtxtDoc :: HsBracket GhcRn -> SDoc
+quotationCtxtDoc :: HsTypedBracket GhcRn -> SDoc
 quotationCtxtDoc br_body
   = hang (text "In the Template Haskell quotation")
          2 (ppr br_body)
diff --git a/compiler/GHC/Tc/Gen/Splice.hs-boot b/compiler/GHC/Tc/Gen/Splice.hs-boot
index 54dd1d0251..68efb320a8 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs-boot
+++ b/compiler/GHC/Tc/Gen/Splice.hs-boot
@@ -10,23 +10,23 @@ import GHC.Tc.Utils.TcType   ( ExpRhoType )
 import GHC.Types.Annotations ( Annotation, CoreAnnTarget )
 import GHC.Hs.Extension ( GhcRn, GhcPs, GhcTc )
 
-import GHC.Hs     ( HsSplice, HsBracket, HsExpr, LHsExpr, LHsType, LPat,
-                    LHsDecl, ThModFinalizers )
+import GHC.Hs     ( HsSplice, HsTypedBracket, HsUntypedBracket, HsExpr,
+                    LHsExpr, LHsType, LPat, LHsDecl, ThModFinalizers )
 import qualified Language.Haskell.TH as TH
 
 tcSpliceExpr :: HsSplice GhcRn
              -> ExpRhoType
              -> TcM (HsExpr GhcTc)
 
+tcTypedBracket :: HsExpr GhcRn
+               -> HsTypedBracket GhcRn
+               -> ExpRhoType
+               -> TcM (HsExpr GhcTc)
 tcUntypedBracket :: HsExpr GhcRn
-                 -> HsBracket GhcRn
+                 -> HsUntypedBracket GhcRn
                  -> [PendingRnSplice]
                  -> ExpRhoType
                  -> TcM (HsExpr GhcTc)
-tcTypedBracket :: HsExpr GhcRn
-               -> HsBracket GhcRn
-               -> ExpRhoType
-               -> TcM (HsExpr GhcTc)
 
 runTopSplice :: DelayedSplice -> TcM (HsExpr GhcTc)
 
diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs
index b8ec635bd4..55730e20d1 100644
--- a/compiler/GHC/Tc/Types/Origin.hs
+++ b/compiler/GHC/Tc/Types/Origin.hs
@@ -705,7 +705,8 @@ exprCtOrigin (RecordUpd {})      = RecordUpdOrigin
 exprCtOrigin (ExprWithTySig {})  = ExprSigOrigin
 exprCtOrigin (ArithSeq {})       = Shouldn'tHappenOrigin "arithmetic sequence"
 exprCtOrigin (HsPragE _ _ e)     = lexprCtOrigin e
-exprCtOrigin (HsBracket {})      = Shouldn'tHappenOrigin "TH bracket"
+exprCtOrigin (HsTypedBracket {}) = Shouldn'tHappenOrigin "TH typed bracket"
+exprCtOrigin (HsUntypedBracket {}) = Shouldn'tHappenOrigin "TH untyped bracket"
 exprCtOrigin (HsSpliceE {})      = Shouldn'tHappenOrigin "TH splice"
 exprCtOrigin (HsProc {})         = Shouldn'tHappenOrigin "proc"
 exprCtOrigin (HsStatic {})       = Shouldn'tHappenOrigin "static expression"
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index 0628ab428c..2c62dda556 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -778,11 +778,25 @@ zonkExpr env (HsAppType ty e t)
        return (HsAppType new_ty new_e t)
        -- NB: the type is an HsType; can't zonk that!
 
-zonkExpr env (HsBracket (HsBracketTc ty wrap bs) body)
+zonkExpr env (HsTypedBracket (HsBracketTc ty wrap bs) body)
   = do wrap' <- traverse zonkQuoteWrap wrap
        bs' <- mapM (zonk_b env) bs
        new_ty <- zonkTcTypeToTypeX env ty
-       return (HsBracket (HsBracketTc new_ty wrap' bs') body)
+       return (HsTypedBracket (HsBracketTc new_ty wrap' bs') body)
+  where
+    zonkQuoteWrap (QuoteWrapper ev ty) = do
+        let ev' = zonkIdOcc env ev
+        ty' <- zonkTcTypeToTypeX env ty
+        return (QuoteWrapper ev' ty')
+
+    zonk_b env' (PendingTcSplice n e) = do e' <- zonkLExpr env' e
+                                           return (PendingTcSplice n e')
+
+zonkExpr env (HsUntypedBracket (HsBracketTc ty wrap bs) body)
+  = do wrap' <- traverse zonkQuoteWrap wrap
+       bs' <- mapM (zonk_b env) bs
+       new_ty <- zonkTcTypeToTypeX env ty
+       return (HsUntypedBracket (HsBracketTc new_ty wrap' bs') body)
   where
     zonkQuoteWrap (QuoteWrapper ev ty) = do
         let ev' = zonkIdOcc env ev