Another raft of Template Haskell clean-up

The handling of typed and untyped brackets was extremely convoluted,
partly because of the evolutionary history.  I've tidied it all up.

See Note [How brackets and nested splices are handled] in TcSplice
for the full story

Main changes:

 * Untyped brackets: after the renamer, HsRnBracketOut carries
   PendingRnSplices for splices in untyped brackets.  In the
   typechecker, these pending splices are typechecked quite
   straigtforwardly, with no ps_var nonsense.

 * Typed brackets: after the renamer typed brackest still look
   like HsBracket. The type checker does the ps_var thing.

 * In TcRnTypes.ThStage, the Brack constructor, we distinguish
   the renaming from typehecking pending-stuff.  Much more
   perspicuous!

 * The "typed" flag is in HsSpliceE, not in HsSplice, because
   only expressions can be typed.  Patterns, types, declarations
   cannot.

There is further improvement to be done to make the handling of
declaration splices more uniform.

20 files changed, 430 insertions, 625 deletions

diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs
index 889155c79e..e3e2bfc915 100644
--- a/compiler/deSugar/Coverage.lhs
+++ b/compiler/deSugar/Coverage.lhs
@@ -571,9 +571,10 @@ addTickHsExpr (HsCoreAnn nm e) =
         liftM2 HsCoreAnn
                 (return nm)
                 (addTickLHsExpr e)
-addTickHsExpr e@(HsBracket     {}) = return e
-addTickHsExpr e@(HsBracketOut  {}) = return e
-addTickHsExpr e@(HsSpliceE  {}) = return e
+addTickHsExpr e@(HsBracket     {})   = return e
+addTickHsExpr e@(HsTcBracketOut  {}) = return e
+addTickHsExpr e@(HsRnBracketOut  {}) = return e
+addTickHsExpr e@(HsSpliceE  {})      = return e
 addTickHsExpr (HsProc pat cmdtop) =
         liftM2 HsProc
                 (addTickLPat pat)
diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs
index 9ede48f4f8..2c8c490531 100644
--- a/compiler/deSugar/DsExpr.lhs
+++ b/compiler/deSugar/DsExpr.lhs
@@ -559,11 +559,11 @@ Here is where we desugar the Template Haskell brackets and escapes
 
 dsExpr (HsRnBracketOut _ _) = panic "dsExpr HsRnBracketOut"
 #ifdef GHCI
-dsExpr (HsBracketOut x ps) = dsBracket x ps
+dsExpr (HsTcBracketOut x ps) = dsBracket x ps
 #else
-dsExpr (HsBracketOut _ _) = panic "dsExpr HsBracketOut"
+dsExpr (HsTcBracketOut _ _) = panic "dsExpr HsBracketOut"
 #endif
-dsExpr (HsSpliceE s)       = pprPanic "dsExpr:splice" (ppr s)
+dsExpr (HsSpliceE _ s)      = pprPanic "dsExpr:splice" (ppr s)
 
 -- Arrow notation extension
 dsExpr (HsProc pat cmd) = dsProcExpr pat cmd
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 6bdcd2fbb7..578b668260 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -67,7 +67,7 @@ import Control.Monad
 import Data.List
 
 -----------------------------------------------------------------------------
-dsBracket :: HsBracket Name -> [PendingSplice] -> DsM CoreExpr
+dsBracket :: HsBracket Name -> [PendingTcSplice] -> DsM CoreExpr
 -- Returns a CoreExpr of type TH.ExpQ
 -- The quoted thing is parameterised over Name, even though it has
 -- been type checked.  We don't want all those type decorations!
@@ -75,7 +75,7 @@ dsBracket :: HsBracket Name -> [PendingSplice] -> DsM CoreExpr
 dsBracket brack splices
   = dsExtendMetaEnv new_bit (do_brack brack)
   where
-    new_bit = mkNameEnv [(n, Splice (unLoc e)) | PendingTcSplice n e <- splices]
+    new_bit = mkNameEnv [(n, Splice (unLoc e)) | (n, e) <- splices]
 
     do_brack (VarBr _ n) = do { MkC e1  <- lookupOcc n ; return e1 }
     do_brack (ExpBr e)   = do { MkC e1  <- repLE e     ; return e1 }
@@ -835,7 +835,7 @@ repTy (HsKindSig t k)       = do
                                 t1 <- repLTy t
                                 k1 <- repLKind k
                                 repTSig t1 k1
-repTy (HsSpliceTy splice _ _) = repSplice splice
+repTy (HsSpliceTy splice _)     = repSplice splice
 repTy (HsExplicitListTy _ tys)  = do
                                     tys1 <- repLTys tys
                                     repTPromotedList tys1
@@ -903,7 +903,7 @@ repRole (L _ Nothing)                 = rep2 inferRName []
 repSplice :: HsSplice Name -> DsM (Core a)
 -- See Note [How brackets and nested splices are handled] in TcSplice
 -- We return a CoreExpr of any old type; the context should know
-repSplice (HsSplice _ n _)
+repSplice (HsSplice n _)
  = do { mb_val <- dsLookupMetaEnv n
        ; case mb_val of
            Just (Splice e) -> do { e' <- dsExpr e
@@ -1026,13 +1026,13 @@ repE (ArithSeq _ _ aseq) =
                              ds3 <- repLE e3
                              repFromThenTo ds1 ds2 ds3
 
-repE (HsSpliceE splice)  = repSplice splice
-repE e@(PArrSeq {})      = notHandled "Parallel arrays" (ppr e)
-repE e@(HsCoreAnn {})    = notHandled "Core annotations" (ppr e)
-repE e@(HsSCC {})        = notHandled "Cost centres" (ppr e)
-repE e@(HsTickPragma {}) = notHandled "Tick Pragma" (ppr e)
-repE e@(HsBracketOut {}) = notHandled "TH brackets" (ppr e)
-repE e                   = notHandled "Expression form" (ppr e)
+repE (HsSpliceE _ splice)  = repSplice splice
+repE e@(PArrSeq {})        = notHandled "Parallel arrays" (ppr e)
+repE e@(HsCoreAnn {})      = notHandled "Core annotations" (ppr e)
+repE e@(HsSCC {})          = notHandled "Cost centres" (ppr e)
+repE e@(HsTickPragma {})   = notHandled "Tick Pragma" (ppr e)
+repE e@(HsTcBracketOut {}) = notHandled "TH brackets" (ppr e)
+repE e                     = notHandled "Expression form" (ppr e)
 
 -----------------------------------------------------------------------------
 -- Building representations of auxillary structures like Match, Clause, Stmt,
diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index 4d6939219b..bae804eb07 100644
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -67,7 +67,7 @@ module HsDecls (
     ) where
 
 -- friends:
-import {-# SOURCE #-}   HsExpr( LHsExpr, HsExpr, HsSplice, pprExpr )
+import {-# SOURCE #-}   HsExpr( LHsExpr, HsExpr, HsSplice, pprExpr, pprUntypedSplice )
         -- Because Expr imports Decls via HsBracket
 
 import HsBinds
@@ -290,7 +290,7 @@ data SpliceDecl id
     deriving (Data, Typeable)
 
 instance OutputableBndr name => Outputable (SpliceDecl name) where
-   ppr (SpliceDecl e _) = ppr e
+   ppr (SpliceDecl (L _ e) _) = pprUntypedSplice e
 \end{code}
 
 
diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs
index bb0f2d9bcb..61c41da6f0 100644
--- a/compiler/hsSyn/HsExpr.lhs
+++ b/compiler/hsSyn/HsExpr.lhs
@@ -246,20 +246,20 @@ data HsExpr id
 
   | HsBracket    (HsBracket id)
 
-    -- See Note [Pending Renamer Splices]
-  | HsRnBracketOut (HsBracket Name)     -- Output of the renamer is
-                                        -- the *original*
-                   [PendingSplice]      -- renamed expression, plus
-                                        -- _renamed_ splices to be
-                                        -- type checked
+    -- See Note [Pending Splices]
+  | HsRnBracketOut
+      (HsBracket Name)     -- Output of the renamer is the *original* renamed
+                           -- expression, plus
+      [PendingRnSplice]    -- _renamed_ splices to be type checked
 
-  | HsBracketOut (HsBracket Name)       -- Output of the type checker is
-                                        -- the *original*
-                 [PendingSplice]        -- renamed expression, plus
-                                        -- _typechecked_ splices to be
-                                        -- pasted back in by the desugarer
+  | HsTcBracketOut
+      (HsBracket Name)     -- Output of the type checker is the *original*
+                           -- renamed expression, plus
+      [PendingTcSplice]    -- _typechecked_ splices to be
+                           -- pasted back in by the desugarer
 
-  | HsSpliceE (HsSplice id)
+  | HsSpliceE    Bool                   -- True <=> typed splice
+                 (HsSplice id)          -- False <=> untyped
 
   | HsQuasiQuoteE (HsQuasiQuote id)
         -- See Note [Quasi-quote overview] in TcSplice
@@ -346,14 +346,15 @@ tupArgPresent (Present {}) = True
 tupArgPresent (Missing {}) = False
 
 -- See Note [Pending Splices]
-data PendingSplice
-  = PendingRnExpSplice Name (LHsExpr Name)
-  | PendingRnPatSplice Name (LHsExpr Name)
-  | PendingRnTypeSplice Name (LHsExpr Name)
-  | PendingRnDeclSplice Name (LHsExpr Name)
+data PendingRnSplice
+  = PendingRnExpSplice        (HsSplice Name)
+  | PendingRnPatSplice        (HsSplice Name)
+  | PendingRnTypeSplice       (HsSplice Name)
+  | PendingRnDeclSplice       (HsSplice Name)
   | PendingRnCrossStageSplice Name
-  | PendingTcSplice Name (LHsExpr Id)
   deriving (Data, Typeable)
+
+type PendingTcSplice = (Name, LHsExpr Id)
 \end{code}
 
 Note [Pending Splices]
@@ -598,12 +599,12 @@ ppr_expr (HsSCC lbl expr)
 ppr_expr (HsWrap co_fn e) = pprHsWrapper (pprExpr e) co_fn
 ppr_expr (HsType id)      = ppr id
 
-ppr_expr (HsSpliceE s)        = pprSplice s
-ppr_expr (HsBracket b)        = pprHsBracket b
+ppr_expr (HsSpliceE t s)       = pprSplice t s
+ppr_expr (HsBracket b)         = pprHsBracket b
 ppr_expr (HsRnBracketOut e []) = ppr e
 ppr_expr (HsRnBracketOut e ps) = ppr e $$ ptext (sLit "pending(rn)") <+> ppr ps
-ppr_expr (HsBracketOut e [])   = ppr e
-ppr_expr (HsBracketOut e ps)   = ppr e $$ ptext (sLit "pending(tc)") <+> ppr ps
+ppr_expr (HsTcBracketOut e []) = ppr e
+ppr_expr (HsTcBracketOut e ps) = ppr e $$ ptext (sLit "pending(tc)") <+> ppr ps
 ppr_expr (HsQuasiQuoteE qq)    = ppr qq
 
 ppr_expr (HsProc pat (L _ (HsCmdTop cmd _ _ _)))
@@ -687,7 +688,7 @@ hsExprNeedsParens (ExplicitPArr {})   = False
 hsExprNeedsParens (HsPar {})          = False
 hsExprNeedsParens (HsBracket {})      = False
 hsExprNeedsParens (HsRnBracketOut {}) = False
-hsExprNeedsParens (HsBracketOut _ []) = False
+hsExprNeedsParens (HsTcBracketOut {}) = False
 hsExprNeedsParens (HsDo sc _ _)
        | isListCompExpr sc            = False
 hsExprNeedsParens _ = True
@@ -1371,17 +1372,19 @@ pprQuals quals = interpp'SP quals
 
 \begin{code}
 data HsSplice id  = HsSplice            --  $z  or $(f 4)
-                        Bool            -- True if typed, False if untyped
                         id              -- The id is just a unique name to
                         (LHsExpr id)    -- identify this splice point
   deriving (Data, Typeable)
 
 instance OutputableBndr id => Outputable (HsSplice id) where
-  ppr = pprSplice
+  ppr (HsSplice n e) = angleBrackets (ppr n <> comma <+> ppr e)
+
+pprUntypedSplice :: OutputableBndr id => HsSplice id -> SDoc
+pprUntypedSplice = pprSplice False
 
-pprSplice :: OutputableBndr id => HsSplice id -> SDoc
-pprSplice (HsSplice isTyped n e)
-    = (if isTyped then ptext (sLit "$$") else char '$')
+pprSplice :: OutputableBndr id => Bool -> HsSplice id -> SDoc
+pprSplice is_typed (HsSplice n e)
+    = (if is_typed then ptext (sLit "$$") else char '$')
       <> ifPprDebug (brackets (ppr n)) <> eDoc
     where
           -- We use pprLExpr to match pprParendExpr:
@@ -1428,13 +1431,12 @@ thBrackets pp_kind pp_body = char '[' <> pp_kind <> char '|' <+>
 thTyBrackets :: SDoc -> SDoc
 thTyBrackets pp_body = ptext (sLit "[||") <+> pp_body <+> ptext (sLit "||]")
 
-instance Outputable PendingSplice where
-  ppr (PendingRnExpSplice name expr)   = ppr (name, expr)
-  ppr (PendingRnPatSplice name expr)   = ppr (name, expr)
-  ppr (PendingRnTypeSplice name expr)  = ppr (name, expr)
-  ppr (PendingRnDeclSplice name expr)  = ppr (name, expr)
+instance Outputable PendingRnSplice where
+  ppr (PendingRnExpSplice s)   = ppr s
+  ppr (PendingRnPatSplice s)   = ppr s
+  ppr (PendingRnTypeSplice s)  = ppr s
+  ppr (PendingRnDeclSplice s)  = ppr s
   ppr (PendingRnCrossStageSplice name) = ppr name
-  ppr (PendingTcSplice name expr)      = ppr (name, expr)
 \end{code}
 
 %************************************************************************
diff --git a/compiler/hsSyn/HsExpr.lhs-boot b/compiler/hsSyn/HsExpr.lhs-boot
index a2ef6528b8..027fd7e0a0 100644
--- a/compiler/hsSyn/HsExpr.lhs-boot
+++ b/compiler/hsSyn/HsExpr.lhs-boot
@@ -33,7 +33,6 @@ instance Data i => Data (HsCmd i)
 instance (Data i, Data body) => Data (MatchGroup i body)
 instance (Data i, Data body) => Data (GRHSs i body)
 
-instance OutputableBndr id => Outputable (HsSplice id)
 instance OutputableBndr id => Outputable (HsExpr id)
 instance OutputableBndr id => Outputable (HsCmd id)
 
@@ -46,8 +45,8 @@ pprLExpr :: (OutputableBndr i) =>
 pprExpr :: (OutputableBndr i) => 
         HsExpr i -> SDoc
 
-pprSplice :: (OutputableBndr i) => 
-        HsSplice i -> SDoc
+pprUntypedSplice :: (OutputableBndr i) => 
+                    HsSplice i -> SDoc
 
 pprPatBind :: (OutputableBndr bndr, OutputableBndr id, Outputable body)
            => LPat bndr -> GRHSs id body -> SDoc
diff --git a/compiler/hsSyn/HsPat.lhs b/compiler/hsSyn/HsPat.lhs
index 463d55e0ff..bf44505514 100644
--- a/compiler/hsSyn/HsPat.lhs
+++ b/compiler/hsSyn/HsPat.lhs
@@ -23,7 +23,7 @@ module HsPat (
         pprParendLPat
     ) where
 
-import {-# SOURCE #-} HsExpr            (SyntaxExpr, LHsExpr, HsSplice, pprLExpr)
+import {-# SOURCE #-} HsExpr            (SyntaxExpr, LHsExpr, HsSplice, pprLExpr, pprUntypedSplice)
 
 -- friends:
 import HsBinds
@@ -271,7 +271,7 @@ pprPat (LitPat s)           = ppr s
 pprPat (NPat l Nothing  _)  = ppr l
 pprPat (NPat l (Just _) _)  = char '-' <> ppr l
 pprPat (NPlusKPat n k _ _)  = hcat [ppr n, char '+', ppr k]
-pprPat (SplicePat splice)   = ppr splice
+pprPat (SplicePat splice)   = pprUntypedSplice splice
 pprPat (QuasiQuotePat qq)   = ppr qq
 pprPat (CoPat co pat _)     = pprHsWrapper (ppr pat) co
 pprPat (SigPatIn pat ty)    = ppr pat <+> dcolon <+> ppr ty
diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs
index dc442506c6..dfc5817a7d 100644
--- a/compiler/hsSyn/HsTypes.lhs
+++ b/compiler/hsSyn/HsTypes.lhs
@@ -38,11 +38,10 @@ module HsTypes (
         pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context,
     ) where
 
-import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
+import {-# SOURCE #-} HsExpr ( HsSplice, pprUntypedSplice )
 
 import HsLit
 
-import NameSet( FreeVars )
 import Name( Name )
 import RdrName( RdrName )
 import DataCon( HsBang(..) )
@@ -230,7 +229,6 @@ data HsType name
   | HsQuasiQuoteTy      (HsQuasiQuote name)
 
   | HsSpliceTy          (HsSplice name) 
-                        FreeVars        -- Variables free in the splice (filled in by renamer)
                         PostTcKind
 
   | HsDocTy             (LHsType name) LHsDocString -- A documented type
@@ -634,7 +632,7 @@ ppr_mono_ty _    (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcol
 ppr_mono_ty _    (HsListTy ty)       = brackets (ppr_mono_lty pREC_TOP ty)
 ppr_mono_ty _    (HsPArrTy ty)       = paBrackets (ppr_mono_lty pREC_TOP ty)
 ppr_mono_ty prec (HsIParamTy n ty)   = maybeParen prec pREC_FUN (ppr n <+> dcolon <+> ppr_mono_lty pREC_TOP ty)
-ppr_mono_ty _    (HsSpliceTy s _ _)  = pprSplice s
+ppr_mono_ty _    (HsSpliceTy s _)    = pprUntypedSplice s
 ppr_mono_ty _    (HsCoreTy ty)       = ppr ty
 ppr_mono_ty _    (HsExplicitListTy _ tys) = quote $ brackets (interpp'SP tys)
 ppr_mono_ty _    (HsExplicitTupleTy _ tys) = quote $ parens (interpp'SP tys)
diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs
index fada34e02f..dd77ac15cf 100644
--- a/compiler/hsSyn/HsUtils.lhs
+++ b/compiler/hsSyn/HsUtils.lhs
@@ -55,7 +55,8 @@ module HsUtils(
   emptyRecStmt, mkRecStmt, 
 
   -- Template Haskell
-  unqualSplice, mkHsSpliceTy, mkHsSpliceE, mkHsSpliceTE, mkHsQuasiQuote, unqualQuasiQuote,
+  mkHsSpliceTy, mkHsSpliceE, mkHsSpliceTE, mkHsSplice,
+  mkHsQuasiQuote, unqualQuasiQuote,
 
   -- Flags
   noRebindableInfo, 
@@ -251,17 +252,17 @@ mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts }
 mkHsOpApp :: LHsExpr id -> id -> LHsExpr id -> HsExpr id
 mkHsOpApp e1 op e2 = OpApp e1 (noLoc (HsVar op)) (error "mkOpApp:fixity") e2
 
-mkHsSplice :: Bool -> LHsExpr RdrName -> HsSplice RdrName
-mkHsSplice isTyped e = HsSplice isTyped unqualSplice e
+mkHsSplice :: LHsExpr RdrName -> HsSplice RdrName
+mkHsSplice e = HsSplice unqualSplice e
 
 mkHsSpliceE :: LHsExpr RdrName -> HsExpr RdrName
-mkHsSpliceE e = HsSpliceE (mkHsSplice False e)
+mkHsSpliceE e = HsSpliceE False (mkHsSplice e)
 
 mkHsSpliceTE :: LHsExpr RdrName -> HsExpr RdrName
-mkHsSpliceTE e = HsSpliceE (mkHsSplice True e)
+mkHsSpliceTE e = HsSpliceE True (mkHsSplice e)
 
 mkHsSpliceTy :: LHsExpr RdrName -> HsType RdrName
-mkHsSpliceTy e = HsSpliceTy (mkHsSplice False e) emptyFVs placeHolderKind
+mkHsSpliceTy e = HsSpliceTy (mkHsSplice e) placeHolderKind
 
 unqualSplice :: RdrName
 unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))
diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index 46a694b42b..79e53b26ae 100644
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -1,4 +1,4 @@
-%
+o%
 % (c) The University of Glasgow, 1996-2003
 
 Functions over HsSyn specialised to RdrName.
@@ -235,11 +235,13 @@ mkSpliceDecl :: LHsExpr RdrName -> HsDecl RdrName
 -- but if she wrote, say,
 --      f x            then behave as if she'd written $(f x)
 --                     ie a SpliceD
-mkSpliceDecl (L _ (HsQuasiQuoteE qq))   = QuasiQuoteD qq
-mkSpliceDecl (L loc (HsSpliceE splice)) = SpliceD (SpliceDecl (L loc splice) Explicit)
-mkSpliceDecl other_expr                 = SpliceD (SpliceDecl (L (getLoc other_expr) splice) Implicit)
+mkSpliceDecl lexpr@(L loc expr)
+  | HsQuasiQuoteE qq <- expr          = QuasiQuoteD qq
+  | HsSpliceE is_typed splice <- expr = ASSERT( not is_typed )
+                                        SpliceD (SpliceDecl (L loc splice) Explicit)
+  | otherwise                         = SpliceD (SpliceDecl (L loc splice) Implicit)
   where
-    HsSpliceE splice = mkHsSpliceE other_expr
+    splice = mkHsSplice lexpr
 
 mkTyLit :: Located (HsTyLit) -> P (LHsType RdrName)
 mkTyLit l =
@@ -675,11 +677,12 @@ checkAPat msg loc e0 = do
      | otherwise -> parseErrorSDoc loc (text "Illegal tuple section in pattern:" $$ ppr e0)
 
    RecordCon c _ (HsRecFields fs dd)
-                      -> do fs <- mapM (checkPatField msg) fs
-                            return (ConPatIn c (RecCon (HsRecFields fs dd)))
-   HsSpliceE s        -> return (SplicePat s)
-   HsQuasiQuoteE q    -> return (QuasiQuotePat q)
-   _                  -> patFail msg loc e0
+                        -> do fs <- mapM (checkPatField msg) fs
+                              return (ConPatIn c (RecCon (HsRecFields fs dd)))
+   HsSpliceE is_typed s | not is_typed 
+                        -> return (SplicePat s)
+   HsQuasiQuoteE q      -> return (QuasiQuotePat q)
+   _                    -> patFail msg loc e0
 
 placeHolderPunRhs :: LHsExpr RdrName
 -- The RHS of a punned record field will be filled in by the renamer
diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 2365d2613e..3b6361881b 100644
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -24,7 +24,7 @@ import HsSyn
 import TcRnMonad
 import Module           ( getModule )
 import RnEnv
-import RnSplice
+import RnSplice         ( rnBracket, rnSpliceExpr, checkThLocalName )
 import RnTypes
 import RnPat
 import DynFlags
@@ -174,7 +174,7 @@ rnExpr (NegApp e _)
 -- (not with an rnExpr crash) in a stage-1 compiler.
 rnExpr e@(HsBracket br_body) = rnBracket e br_body
 
-rnExpr (HsSpliceE splice) = rnSpliceExpr splice
+rnExpr (HsSpliceE is_typed splice) = rnSpliceExpr is_typed splice
 
 
 rnExpr (HsQuasiQuoteE qq)
diff --git a/compiler/rename/RnSplice.lhs b/compiler/rename/RnSplice.lhs
index fc0c499157..a578ef8d10 100644
--- a/compiler/rename/RnSplice.lhs
+++ b/compiler/rename/RnSplice.lhs
@@ -1,7 +1,8 @@
 \begin{code}
 module RnSplice (
-        rnSplice, rnSpliceType, rnSpliceExpr, rnSplicePat, rnSpliceDecl,
-        rnBracket, checkTH,
+        rnTopSpliceDecls,
+        rnSpliceType, rnSpliceExpr, rnSplicePat, rnSpliceDecl,
+        rnBracket,
         checkThLocalName
   ) where
 
@@ -15,13 +16,13 @@ import TcRnMonad
 #ifdef GHCI
 import Control.Monad    ( unless, when )
 import DynFlags
-import DsMeta           ( expQTyConName, patQTyConName, typeQTyConName )
+import DsMeta           ( decsQTyConName, expQTyConName, patQTyConName, typeQTyConName )
 import LoadIface        ( loadInterfaceForName )
 import Module
 import RnEnv
-import RnPat
+import RnPat            ( rnPat )
 import RnSource         ( rnSrcDecls, findSplice )
-import RnTypes
+import RnTypes          ( rnLHsType )
 import SrcLoc
 import TcEnv            ( checkWellStaged, tcMetaTy )
 import Outputable
@@ -30,7 +31,7 @@ import FastString
 
 import {-# SOURCE #-} RnExpr   ( rnLExpr )
 import {-# SOURCE #-} TcExpr   ( tcMonoExpr )
-import {-# SOURCE #-} TcSplice ( runMetaE, runMetaP, runMetaT, tcTopSpliceExpr )
+import {-# SOURCE #-} TcSplice ( runMetaD, runMetaE, runMetaP, runMetaT, tcTopSpliceExpr )
 #endif
 \end{code}
 
@@ -39,14 +40,14 @@ import {-# SOURCE #-} TcSplice ( runMetaE, runMetaP, runMetaT, tcTopSpliceExpr )
 rnBracket :: HsExpr RdrName -> HsBracket RdrName -> RnM (HsExpr Name, FreeVars)
 rnBracket e _ = failTH e "Template Haskell bracket"
 
-rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
-rnSplice e = failTH e "Template Haskell splice"
+rnTopSpliceDecls :: HsSplice RdrName -> RnM ([LHsDecl RdrName], FreeVars)
+rnTopSpliceDecls e = failTH e "Template Haskell top splice"
 
 rnSpliceType :: HsSplice RdrName -> PostTcKind -> RnM (HsType Name, FreeVars)
 rnSpliceType e _ = failTH e "Template Haskell type splice"
 
-rnSpliceExpr :: HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
-rnSpliceExpr e = failTH e "Template Haskell splice"
+rnSpliceExpr :: Bool -> HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
+rnSpliceExpr _ e = failTH e "Template Haskell splice"
 
 rnSplicePat :: HsSplice RdrName -> RnM (Pat Name, FreeVars)
 rnSplicePat e = failTH e "Template Haskell pattern splice"
@@ -82,210 +83,162 @@ thereby get some bogus unused-import warnings, but we won't crash the
 type checker.  Not very satisfactory really.
 
 \begin{code}
+rnSpliceGen :: Bool                                     -- Typed splice?
+            -> (HsSplice Name -> RnM (a, FreeVars))     -- Outside brackets, run splice
+            -> (HsSplice Name -> (PendingRnSplice, a))  -- Inside brackets, make it pending
+            -> HsSplice RdrName
+            -> RnM (a, FreeVars)
+rnSpliceGen is_typed_splice run_splice pend_splice splice@(HsSplice _ expr)
+  = addErrCtxt (spliceCtxt (HsSpliceE is_typed_splice splice)) $
+    setSrcSpan (getLoc expr) $ do
+    { stage <- getStage
+    ; case stage of
+        Brack pop_stage RnPendingTyped
+          -> do { checkTc is_typed_splice illegalUntypedSplice
+                ; (splice', fvs) <- setStage pop_stage $
+                                    rnSplice splice
+                ; let (_pending_splice, result) = pend_splice splice'
+                ; return (result, fvs) }
+
+        Brack pop_stage (RnPendingUntyped ps_var)
+          -> do { checkTc (not is_typed_splice) illegalTypedSplice
+                ; (splice', fvs) <- setStage pop_stage $
+                                    rnSplice splice
+                ; let (pending_splice, result) = pend_splice splice'
+                ; ps <- readMutVar ps_var
+                ; writeMutVar ps_var (pending_splice : ps)
+                ; return (result, fvs) }
+
+        _ ->  do { (splice', fvs1) <- setStage (Splice is_typed_splice) $
+                                      rnSplice splice
+
+                 ; (result, fvs2) <- run_splice splice'
+                 ; return (result, fvs1 `plusFV` fvs2) } }
+
+---------------------
 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
 -- Not exported...used for all
-rnSplice (HsSplice isTyped n expr)
+rnSplice (HsSplice n expr)
   = do  { checkTH expr "Template Haskell splice"
         ; loc  <- getSrcSpanM
         ; n' <- newLocalBndrRn (L loc n)
         ; (expr', fvs) <- rnLExpr expr
+        ; return (HsSplice n' expr', fvs) }
 
-        ; if isTyped
-          then do
-            { -- Ugh!  See Note [Splices] above
-              lcl_rdr <- getLocalRdrEnv
-            ; gbl_rdr <- getGlobalRdrEnv
-            ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
-                                                        isLocalGRE gre]
-                  lcl_names = mkNameSet (localRdrEnvElts lcl_rdr)
-
-            ; return (HsSplice isTyped n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names)
-            }
-          else return (HsSplice isTyped n' expr', fvs)
-        }
-\end{code}
 
-\begin{code}
-rnSpliceType :: HsSplice RdrName -> PostTcKind -> RnM (HsType Name, FreeVars)
-rnSpliceType splice@(HsSplice isTypedSplice _ expr) k
-  = setSrcSpan (getLoc expr) $ do
-    { stage <- getStage
-    ; case stage of
-        { Brack isTypedBrack pop_stage ps_var _ ->
-            do { when (isTypedBrack && not isTypedSplice) $
-                     failWithTc illegalUntypedSplice
-               ; when (not isTypedBrack && isTypedSplice) $
-                     failWithTc illegalTypedSplice
-
-                 -- ToDo: deal with fvs
-               ; (splice'@(HsSplice _ name expr'), fvs) <- setStage pop_stage $
-                                                           rnSplice splice
-
-               ; ps <- readMutVar ps_var
-               ; writeMutVar ps_var (PendingRnTypeSplice name expr' : ps)
-
-               ; return (HsSpliceTy splice' fvs k, fvs)
-               }
-        ; _ ->
-            do { -- ToDo: deal with fvs
-                 (splice', fvs) <- addErrCtxt (spliceResultDoc expr) $
-                                   setStage (Splice isTypedSplice) $
-                                   rnSplice splice
-               ; maybeExpandTopSplice splice' fvs
-               }
-        }
-    }
+---------------------
+rnSpliceExpr :: Bool -> HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
+rnSpliceExpr is_typed splice
+  = rnSpliceGen is_typed run_expr_splice pend_expr_splice splice
   where
-    maybeExpandTopSplice :: HsSplice Name -> FreeVars -> RnM (HsType Name, FreeVars)
-    maybeExpandTopSplice splice@(HsSplice True _ _) fvs
-      = return (HsSpliceTy splice fvs k, fvs)
+    pend_expr_splice :: HsSplice Name -> (PendingRnSplice, HsExpr Name)
+    pend_expr_splice rn_splice
+        = (PendingRnExpSplice rn_splice, HsSpliceE is_typed rn_splice)
+
+    run_expr_splice :: HsSplice Name -> RnM (HsExpr Name, FreeVars)
+    run_expr_splice rn_splice@(HsSplice _ expr)
+      | is_typed   -- Run it later, in the type checker
+      = do {  -- Ugh!  See Note [Splices] above
+              lcl_rdr <- getLocalRdrEnv
+           ; gbl_rdr <- getGlobalRdrEnv
+           ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr
+                                                     , isLocalGRE gre]
+                 lcl_names = mkNameSet (localRdrEnvElts lcl_rdr)
 
-    maybeExpandTopSplice (HsSplice False _ expr) _
-      = do { -- The splice must have type TypeQ
-           ; meta_exp_ty <- tcMetaTy typeQTyConName
+           ; return (HsSpliceE is_typed rn_splice, lcl_names `plusFV` gbl_names) }
+
+      | otherwise  -- Run it here
+      = do { -- The splice must have type ExpQ
+           ; meta_exp_ty <- tcMetaTy expQTyConName
 
              -- Typecheck the expression
            ; zonked_q_expr <- tcTopSpliceExpr False $
                               tcMonoExpr expr meta_exp_ty
 
              -- Run the expression
-           ; hs_ty2 <- runMetaT zonked_q_expr
-           ; showSplice "type" expr (ppr hs_ty2)
-
-           ; (hs_ty3, fvs) <- addErrCtxt (spliceResultDoc expr) $
-                              do { let doc = SpliceTypeCtx hs_ty2
-                                 ; checkNoErrs $ rnLHsType doc hs_ty2
-                                   -- checkNoErrs: see Note [Renamer errors]
-                                 }
-           ; return (unLoc hs_ty3, fvs)
-           }
-\end{code}
+           ; expr2 <- runMetaE zonked_q_expr
+           ; showSplice "expression" expr (ppr expr2)
 
-\begin{code}
-rnSpliceExpr :: HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
-rnSpliceExpr splice@(HsSplice isTypedSplice _ expr)
-  = addErrCtxt (exprCtxt (HsSpliceE splice)) $
-    setSrcSpan (getLoc expr) $ do
-    { stage <- getStage
-    ; case stage of
-        { Brack isTypedBrack pop_stage ps_var _ ->
-            do { when (isTypedBrack && not isTypedSplice) $
-                     failWithTc illegalUntypedSplice
-               ; when (not isTypedBrack && isTypedSplice) $
-                     failWithTc illegalTypedSplice
-
-               ; (splice'@(HsSplice _ name expr'), fvs) <- setStage pop_stage $
-                                                           rnSplice splice
-
-               ; ps <- readMutVar ps_var
-               ; writeMutVar ps_var (PendingRnExpSplice name expr' : ps)
-
-               ; return (HsSpliceE splice', fvs)
-               }
-        ; _ ->
-            do { (splice', fvs) <- addErrCtxt (spliceResultDoc expr) $
-                                   setStage (Splice isTypedSplice) $
-                                   rnSplice splice
-               ; maybeExpandTopSplice splice' fvs
-               }
-        }
-    }
+           ; (lexpr3, fvs) <- checkNoErrs $
+                              rnLExpr expr2
+           ; return (unLoc lexpr3, fvs)  }
+
+----------------------
+rnSpliceType :: HsSplice RdrName -> PostTcKind -> RnM (HsType Name, FreeVars)
+rnSpliceType splice k
+  = rnSpliceGen False run_type_splice pend_type_splice splice
   where
-    maybeExpandTopSplice :: HsSplice Name -> FreeVars -> RnM (HsExpr Name, FreeVars)
-    maybeExpandTopSplice splice@(HsSplice True _ _) fvs
-      = return (HsSpliceE splice, fvs)
+    pend_type_splice rn_splice
+       = (PendingRnTypeSplice rn_splice, HsSpliceTy rn_splice k)
 
-    maybeExpandTopSplice (HsSplice False _ expr) _
-      = do { -- The splice must have type ExpQ
-           ; meta_exp_ty <- tcMetaTy expQTyConName
+    run_type_splice (HsSplice _ expr)
+       = do { meta_exp_ty <- tcMetaTy typeQTyConName
+
+              -- Typecheck the expression
+            ; zonked_q_expr <- tcTopSpliceExpr False $
+                               tcMonoExpr expr meta_exp_ty
+
+              -- Run the expression
+            ; hs_ty2 <- runMetaT zonked_q_expr
+            ; showSplice "type" expr (ppr hs_ty2)
+
+            ; (hs_ty3, fvs) <- do { let doc = SpliceTypeCtx hs_ty2
+                                  ; checkNoErrs $ rnLHsType doc hs_ty2
+                                    -- checkNoErrs: see Note [Renamer errors]
+                                  }
+            ; return (unLoc hs_ty3, fvs) }
+
+----------------------
+rnSplicePat :: HsSplice RdrName -> RnM (Pat Name, FreeVars)
+rnSplicePat splice
+  = rnSpliceGen False run_pat_splice pend_pat_splice splice
+  where
+    pend_pat_splice rn_splice
+      = (PendingRnPatSplice rn_splice, SplicePat rn_splice)
+
+    run_pat_splice (HsSplice _ expr)
+      = do { meta_exp_ty <- tcMetaTy patQTyConName
 
              -- Typecheck the expression
            ; zonked_q_expr <- tcTopSpliceExpr False $
                               tcMonoExpr expr meta_exp_ty
 
              -- Run the expression
-           ; expr2 <- runMetaE zonked_q_expr
-           ; showSplice "expression" expr (ppr expr2)
+           ; pat <- runMetaP zonked_q_expr
+           ; showSplice "pattern" expr (ppr pat)
 
-           ; (lexpr3, fvs) <- addErrCtxt (spliceResultDoc expr) $
-                              checkNoErrs $
-                              rnLExpr expr2
-           ; return (unLoc lexpr3, fvs)
-           }
-\end{code}
+           ; (pat', fvs) <- checkNoErrs $
+                            rnPat ThPatSplice pat $ \pat' -> return (pat', emptyFVs)
 
-\begin{code}
-rnSplicePat :: HsSplice RdrName -> RnM (Pat Name, FreeVars)
-rnSplicePat (HsSplice True _ _)
-  = panic "rnSplicePat: encountered typed pattern splice"
-
-rnSplicePat splice@(HsSplice False _ expr)
-  = addErrCtxt (exprCtxt (HsSpliceE splice)) $
-    setSrcSpan (getLoc expr) $ do
-    { stage <- getStage
-     ; case stage of
-         { Brack isTypedBrack pop_stage ps_var _ ->
-             do { checkTc (not isTypedBrack) illegalUntypedSplice
+           ; return (unLoc pat', fvs) }
 
-                ; (splice'@(HsSplice _ name expr'), fvs) <- setStage pop_stage $
-                                                            rnSplice splice
+----------------------
+rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
+rnSpliceDecl (SpliceDecl (L loc splice) flg)
+  = rnSpliceGen False run_decl_splice pend_decl_splice splice
+  where
+    pend_decl_splice rn_splice
+       = (PendingRnDeclSplice rn_splice, SpliceDecl(L loc rn_splice) flg)
 
-                ; ps <- readMutVar ps_var
-                ; writeMutVar ps_var (PendingRnPatSplice name expr' : ps)
-
-                ; return (SplicePat splice', fvs)
-                }
-         ; _ -> 
-             do { (HsSplice _ _ expr', fvs) <- addErrCtxt (spliceResultDoc expr) $
-                                               setStage (Splice False) $
-                                               rnSplice splice
-
-                  -- The splice must have type Pat
-                ; meta_exp_ty <- tcMetaTy patQTyConName
-
-                  -- Typecheck the expression
-                ; zonked_q_expr <- tcTopSpliceExpr False $
-                                   tcMonoExpr expr' meta_exp_ty
-
-                  -- Run the expression
-                ; pat <- runMetaP zonked_q_expr
-                ; showSplice "pattern" expr' (ppr pat)
-
-                ; (pat', _) <- addErrCtxt (spliceResultDoc expr) $
-                               checkNoErrs $
-                               rnPat ThPatSplice pat $ \pat' -> return (pat', emptyFVs)
-
-                ; return (unLoc pat', fvs)
-                }
-         }
-     }
+    run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (ppr rn_splice)
 \end{code}
 
 \begin{code}
-rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
-rnSpliceDecl (SpliceDecl (L _ (HsSplice True _ _)) _)
-  = panic "rnSpliceDecls: encountered typed declaration splice"
+rnTopSpliceDecls :: HsSplice RdrName -> RnM ([LHsDecl RdrName], FreeVars)
+-- Declaration splice at the very top level of the module
+rnTopSpliceDecls (HsSplice _ expr)
+   = do  { (expr', fvs) <- setStage (Splice False) $
+                           rnLExpr expr
 
-rnSpliceDecl (SpliceDecl (L loc splice@(HsSplice False _ expr)) flg)
-  = addErrCtxt (exprCtxt (HsSpliceE splice)) $
-    setSrcSpan (getLoc expr) $ do
-    { stage <- getStage
-     ; case stage of
-         { Brack isTypedBrack pop_stage ps_var _ ->
-             do { checkTc (not isTypedBrack) illegalUntypedSplice
+         ; list_q <- tcMetaTy decsQTyConName     -- Q [Dec]
+         ; zonked_q_expr <- tcTopSpliceExpr False (tcMonoExpr expr' list_q)
 
-                ; (splice'@(HsSplice _ name expr'), fvs) <- setStage pop_stage $
-                                                            rnSplice splice
+                -- Run the expression
+         ; decls <- runMetaD zonked_q_expr
+         ; showSplice "declarations" expr'
+                 (ppr (getLoc expr) $$ (vcat (map ppr decls)))
 
-                ; ps <- readMutVar ps_var
-                ; writeMutVar ps_var (PendingRnDeclSplice name expr' : ps)
-
-                ; return (SpliceDecl (L loc splice') flg, fvs)
-                }
-         ; _ -> 
-           pprPanic "rnSpliceDecls: should not have been called on top-level splice" (ppr expr)
-         }
-     }
+         ; return (decls,fvs) }
 \end{code}
 
 %************************************************************************
@@ -317,16 +270,16 @@ rnBracket e br_body
          -- Brackets are desugared to code that mentions the TH package
        ; recordThUse
 
-       ; pending_splices <- newMutVar []
-       ; let brack_stage = Brack (isTypedBracket br_body)
-                                 cur_stage pending_splices
-                                 (error "rnBracket: don't neet lie")
+       ; 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) }
 
-       ; (body', fvs_e) <- setStage brack_stage $
-                           rn_bracket cur_stage br_body
-       ; pendings <- readMutVar pending_splices
-
-       ; return (HsRnBracketOut body' pendings, 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)
@@ -405,9 +358,8 @@ rn_bracket _ (TExpBr e) = do { (e', fvs) <- rnLExpr e
 \end{code}
 
 \begin{code}
-exprCtxt :: HsExpr RdrName -> SDoc
-exprCtxt expr
-  = hang (ptext (sLit "In the expression:")) 2 (ppr expr)
+spliceCtxt :: HsExpr RdrName -> SDoc
+spliceCtxt expr= hang (ptext (sLit "In the splice:")) 2 (ppr expr)
 
 showSplice :: String -> LHsExpr Name -> SDoc -> TcM ()
 -- Note that 'before' is *renamed* but not *typechecked*
@@ -447,11 +399,11 @@ 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:"))
-              2 (char '$' <> pprParendExpr expr)
-        , ptext (sLit "To see what the splice expanded to, use -ddump-splices") ]
+-- spliceResultDoc :: OutputableBndr id => LHsExpr id -> SDoc
+-- spliceResultDoc expr
+--  = vcat [ hang (ptext (sLit "In the splice:"))
+--              2 (char '$' <> pprParendExpr expr)
+--        , ptext (sLit "To see what the splice expanded to, use -ddump-splices") ]
 #endif
 \end{code}
 
@@ -483,10 +435,7 @@ checkCrossStageLifting :: TopLevelFlag -> Name -> ThStage -> TcM ()
 -- Examples   \x -> [| x |]
 --            [| map |]
 
-checkCrossStageLifting _ _ Comp      = return ()
-checkCrossStageLifting _ _ (Splice _) = return ()
-
-checkCrossStageLifting top_lvl name (Brack _ _ ps_var _)
+checkCrossStageLifting top_lvl name (Brack _ (RnPendingUntyped ps_var))
   | isTopLevel top_lvl
         -- Top-level identifiers in this module,
         -- (which have External Names)
@@ -511,8 +460,9 @@ checkCrossStageLifting top_lvl name (Brack _ _ ps_var _)
     do  { traceRn (text "checkCrossStageLifting" <+> ppr name)
         ; -- Update the pending splices
         ; ps <- readMutVar ps_var
-        ; writeMutVar ps_var (PendingRnCrossStageSplice name : ps)
-        }
+        ; writeMutVar ps_var (PendingRnCrossStageSplice name : ps) }
+
+checkCrossStageLifting _ _ _ = return ()
 #endif /* GHCI */
 \end{code}
 
diff --git a/compiler/rename/RnSplice.lhs-boot b/compiler/rename/RnSplice.lhs-boot
index 25d5cc949d..5f417ae7fc 100644
--- a/compiler/rename/RnSplice.lhs-boot
+++ b/compiler/rename/RnSplice.lhs-boot
@@ -7,10 +7,7 @@ import RdrName
 import Name
 import NameSet
 
-rnBracket :: HsExpr RdrName -> HsBracket RdrName -> RnM (HsExpr Name, FreeVars)
-
-rnSpliceType :: HsSplice RdrName -> PostTcKind -> RnM (HsType Name, FreeVars)
-rnSpliceExpr :: HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
-rnSplicePat  :: HsSplice RdrName -> RnM (Pat Name, FreeVars)
+rnSpliceType :: HsSplice RdrName   -> PostTcKind -> RnM (HsType Name, FreeVars)
+rnSplicePat  :: HsSplice RdrName   -> RnM (Pat Name, FreeVars)
 rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
 \end{code}
diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs
index 0052393bb4..23c54c3bed 100644
--- a/compiler/rename/RnTypes.lhs
+++ b/compiler/rename/RnTypes.lhs
@@ -249,7 +249,7 @@ rnHsTyKi isType doc (HsEqTy ty1 ty2)
        ; (ty2', fvs2) <- rnLHsType doc ty2
        ; return (HsEqTy ty1' ty2', fvs1 `plusFV` fvs2) }
 
-rnHsTyKi isType _ (HsSpliceTy sp _ k)
+rnHsTyKi isType _ (HsSpliceTy sp k)
   = ASSERT( isType )
     rnSpliceType sp k
 
diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index 6f3eb41ffd..2c462970bb 100644
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -1,4 +1,4 @@
-%
+c%
 % (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
@@ -12,7 +12,7 @@ module TcExpr ( tcPolyExpr, tcPolyExprNC, tcMonoExpr, tcMonoExprNC,
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-}   TcSplice( tcSpliceExpr, tcBracket )
+import {-# SOURCE #-}   TcSplice( tcSpliceExpr, tcTypedBracket, tcUntypedBracket )
 #ifdef GHCI
 import DsMeta( liftStringName, liftName )
 #endif
@@ -797,13 +797,9 @@ tcExpr (PArrSeq _ _) _
 %************************************************************************
 
 \begin{code}
-        -- Rename excludes these cases otherwise
-tcExpr (HsSpliceE splice)        res_ty = tcSpliceExpr splice res_ty
-tcExpr (HsRnBracketOut brack ps) res_ty = tcBracket brack ps res_ty
-tcExpr e@(HsBracketOut _ _) _ =
-    pprPanic "Should never see HsBracketOut in type checker" (ppr e)
-tcExpr e@(HsQuasiQuoteE _) _ =
-    pprPanic "Should never see HsQuasiQuoteE in type checker" (ppr e)
+tcExpr (HsSpliceE is_ty splice)  res_ty = tcSpliceExpr is_ty splice res_ty
+tcExpr (HsBracket brack)         res_ty = tcTypedBracket   brack res_ty
+tcExpr (HsRnBracketOut brack ps) res_ty = tcUntypedBracket brack ps res_ty
 \end{code}
 
 
@@ -816,6 +812,7 @@ tcExpr e@(HsQuasiQuoteE _) _ =
 \begin{code}
 tcExpr other _ = pprPanic "tcMonoExpr" (ppr other)
   -- Include ArrForm, ArrApp, which shouldn't appear at all
+  -- Also HsTcBracketOut, HsQuasiQuoteE
 \end{code}
 
 
@@ -1290,10 +1287,7 @@ checkCrossStageLifting :: Id -> ThStage -> TcM ()
 --            [| map |]
 -- There is no error-checking to do, because the renamer did that
 
-checkCrossStageLifting _ Comp      = return ()
-checkCrossStageLifting _ (Splice _) = return ()
-
-checkCrossStageLifting id (Brack _ _ ps_var lie_var)
+checkCrossStageLifting id (Brack _ (TcPending ps_var lie_var))
   =     -- Nested identifiers, such as 'x' in
         -- E.g. \x -> [| h x |]
         -- We must behave as if the reference to x was
@@ -1316,17 +1310,19 @@ checkCrossStageLifting id (Brack _ _ ps_var lie_var)
                                      -- See Note [Lifting strings]
                         ; return (HsVar sid) }
                   else
-                     setConstraintVar lie_var   $ do
+                     setConstraintVar lie_var   $
                           -- Put the 'lift' constraint into the right LIE
                      newMethodFromName (OccurrenceOf (idName id))
                                        DsMeta.liftName id_ty
 
                    -- Update the pending splices
         ; ps <- readMutVar ps_var
-        ; writeMutVar ps_var (PendingTcSplice (idName id) (nlHsApp (noLoc lift) (nlHsVar id)) : ps)
+        ; writeMutVar ps_var ((idName id, nlHsApp (noLoc lift) (nlHsVar id)) : ps)
 
         ; return () }
 
+checkCrossStageLifting _ _ = return ()
+
 polySpliceErr :: Id -> SDoc
 polySpliceErr id
   = ptext (sLit "Can't splice the polymorphic local variable") <+> quotes (ppr id)
diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs
index 691a9ab496..8b136f56e2 100644
--- a/compiler/typecheck/TcHsSyn.lhs
+++ b/compiler/typecheck/TcHsSyn.lhs
@@ -556,31 +556,15 @@ zonkExpr env (HsApp e1 e2)
 zonkExpr _ e@(HsRnBracketOut _ _)
   = pprPanic "zonkExpr: HsRnBracketOut" (ppr e)
 
-zonkExpr env (HsBracketOut body bs)
+zonkExpr env (HsTcBracketOut body bs)
   = do bs' <- mapM zonk_b bs
-       return (HsBracketOut body bs')
+       return (HsTcBracketOut body bs')
   where
-    zonk_b (PendingRnExpSplice _ e)
-      = pprPanic "zonkExpr: PendingRnExpSplice" (ppr e)
+    zonk_b (n, e) = do e' <- zonkLExpr env e
+                       return (n, e')
 
-    zonk_b (PendingRnPatSplice _ e)
-      = pprPanic "zonkExpr: PendingRnPatSplice" (ppr e)
-
-    zonk_b (PendingRnCrossStageSplice n)
-      = pprPanic "zonkExpr: PendingRnCrossStageSplice" (ppr n)
-
-    zonk_b (PendingRnTypeSplice _ e)
-      = pprPanic "zonkExpr: PendingRnTypeSplice" (ppr e)
-
-    zonk_b (PendingRnDeclSplice _ e)
-      = pprPanic "zonkExpr: PendingRnDeclSplice" (ppr e)
-
-    zonk_b (PendingTcSplice n e)
-      = do e' <- zonkLExpr env e
-           return (PendingTcSplice n e')
-
-zonkExpr _ (HsSpliceE s) = WARN( True, ppr s ) -- Should not happen
-                           return (HsSpliceE s)
+zonkExpr _ (HsSpliceE t s) = WARN( True, ppr s ) -- Should not happen
+                             return (HsSpliceE t s)
 
 zonkExpr env (OpApp e1 op fixity e2)
   = do new_e1 <- zonkLExpr env e1
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 73f78b793c..0926b49259 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -22,8 +22,8 @@ module TcRnDriver (
     ) where
 
 #ifdef GHCI
-import {-# SOURCE #-} TcSplice ( tcSpliceDecls, runQuasi )
-import RnSplice ( rnSplice )
+import {-# SOURCE #-} TcSplice ( runQuasi )
+import RnSplice ( rnTopSpliceDecls )
 #endif
 
 import DynFlags
@@ -546,12 +546,7 @@ tc_rn_src_decls boot_details ds
             -- If there's a splice, we must carry on
           ; Just (SpliceDecl (L _ splice) _, rest_ds) ->
             do { -- Rename the splice expression, and get its supporting decls
-                 (rn_splice, splice_fvs) <- checkNoErrs (rnSplice splice)
-                 -- checkNoErrs: don't typecheck if renaming failed
-               ; rnDump (ppr rn_splice)
-
-                 -- Execute the splice
-               ; spliced_decls <- tcSpliceDecls rn_splice
+                 (spliced_decls, splice_fvs) <- checkNoErrs (rnTopSpliceDecls splice)
 
                  -- Glue them on the front of the remaining decls and loop
                ; setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $
diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 57112d35ff..e16bf569f4 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -35,7 +35,7 @@ module TcRnTypes(
         pprTcTyThingCategory, pprPECategory,
 
         -- Template Haskell
-        ThStage(..), topStage, topAnnStage, topSpliceStage,
+        ThStage(..), PendingStuff(..), topStage, topAnnStage, topSpliceStage,
         ThLevel, impLevel, outerLevel, thLevel,
 
         -- Arrows
@@ -536,10 +536,18 @@ data ThStage    -- See Note [Template Haskell state diagram] in TcSplice
                 -- Binding level = 1
 
   | Brack                       -- Inside brackets
-      Bool                      --   True if inside a typed bracket, False otherwise
-      ThStage                   --   Binding level = level(stage) + 1
-      (TcRef [PendingSplice])   --   Accumulate pending splices here
-      (TcRef WantedConstraints) --     and type constraints here
+      ThStage                   --   Enclosing stage
+      PendingStuff
+
+data PendingStuff
+  = RnPendingUntyped              -- Renaming the inside of an *untyped* bracket
+      (TcRef [PendingRnSplice])   -- Pending splices in here
+
+  | RnPendingTyped                -- Renaming the inside of a *typed* bracket
+
+  | TcPending                     -- Typechecking the iniside of a typed bracket
+      (TcRef [PendingTcSplice])   --   Accumulate pending splices here
+      (TcRef WantedConstraints)   --     and type constraints here
 
 topStage, topAnnStage, topSpliceStage :: ThStage
 topStage       = Comp
@@ -547,9 +555,9 @@ topAnnStage    = Splice False
 topSpliceStage = Splice False
 
 instance Outputable ThStage where
-   ppr (Splice _)      = text "Splice"
-   ppr Comp            = text "Comp"
-   ppr (Brack _ s _ _) = text "Brack" <> parens (ppr s)
+   ppr (Splice _)  = text "Splice"
+   ppr Comp        = text "Comp"
+   ppr (Brack s _) = text "Brack" <> parens (ppr s)
 
 type ThLevel = Int
     -- NB: see Note [Template Haskell levels] in TcSplice
@@ -563,9 +571,9 @@ impLevel = 0    -- Imported things; they can be used inside a top level splice
 outerLevel = 1  -- Things defined outside brackets
 
 thLevel :: ThStage -> ThLevel
-thLevel (Splice _)      = 0
-thLevel Comp            = 1
-thLevel (Brack _ s _ _) = thLevel s + 1
+thLevel (Splice _)  = 0
+thLevel Comp        = 1
+thLevel (Brack s _) = thLevel s + 1
 
 ---------------------------
 -- Arrow-notation context
diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index 29fae0e1b5..2277871daf 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -12,7 +12,7 @@ TcSplice: Template Haskell splices
 module TcSplice(
      -- These functions are defined in stage1 and stage2
      -- The raise civilised errors in stage1
-     tcSpliceExpr, tcSpliceDecls, tcBracket,
+     tcSpliceExpr, tcSpliceDecls, tcTypedBracket, tcUntypedBracket,
      runQuasiQuoteExpr, runQuasiQuotePat,
      runQuasiQuoteDecl, runQuasiQuoteType,
      runAnnotation,
@@ -114,9 +114,10 @@ import GHC.Exts         ( unsafeCoerce# )
 %************************************************************************
 
 \begin{code}
-tcBracket     :: HsBracket Name -> [PendingSplice] -> TcRhoType -> TcM (HsExpr TcId)
-tcSpliceDecls :: HsSplice Name -> TcM [LHsDecl RdrName]
-tcSpliceExpr  :: HsSplice Name -> TcRhoType -> TcM (HsExpr TcId)
+tcTypedBracket   :: HsBracket Name -> TcRhoType -> TcM (HsExpr TcId)
+tcUntypedBracket :: HsBracket Name -> [PendingRnSplice] -> TcRhoType -> TcM (HsExpr TcId)
+tcSpliceDecls    :: HsSplice Name -> TcM [LHsDecl RdrName]
+tcSpliceExpr     :: Bool -> HsSplice Name -> TcRhoType -> TcM (HsExpr TcId)
         -- None of these functions add constraints to the LIE
 
 runQuasiQuoteExpr :: HsQuasiQuote RdrName -> RnM (LHsExpr RdrName)
@@ -127,8 +128,9 @@ runQuasiQuoteDecl :: HsQuasiQuote RdrName -> RnM [LHsDecl RdrName]
 runAnnotation     :: CoreAnnTarget -> LHsExpr Name -> TcM Annotation
 
 #ifndef GHCI
-tcBracket     x _ _ = failTH x "Template Haskell bracket"
-tcSpliceExpr  e _   = failTH e "Template Haskell splice"
+tcTypedBracket   x _   = failTH x "Template Haskell bracket"
+tcUntypedBracket x _ _ = failTH x "Template Haskell bracket"
+tcSpliceExpr  _ e _ = failTH e "Template Haskell splice"
 tcSpliceDecls x     = failTH x "Template Haskell declaration splice"
 
 runQuasiQuoteExpr q = failTH q "quasiquote"
@@ -162,19 +164,51 @@ very straightforwardly:
 
 Note [How brackets and nested splices are handled]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Nested splices (those inside a [| .. |] quotation bracket), are treated
-quite differently.
-
-  * After typechecking, the bracket [| |] carries
-
-     a) A mutable list of PendingSplice
-          type PendingSplice = (Name, LHsExpr Id)
-
-     b) The quoted expression e, *renamed*: (HsExpr Name)
-          The expression e has been typechecked, but the result of
-          that typechecking is discarded.
-
-  * The brakcet is desugared by DsMeta.dsBracket.  It
+Nested splices (those inside a [| .. |] quotation bracket),
+are treated quite differently.
+
+Remember, there are two forms of bracket
+         typed   [|| e ||]
+   and untyped   [|  e  |]
+
+The life cycle of a typed bracket:
+   * Starts as HsBracket
+
+   * When renaming:
+        * Set the ThStage to (Brack s RnPendingTyped)
+        * Rename the body
+        * Result is still a HsBracket
+
+   * When typechecking:
+        * Set the ThStage to (Brack s (TcPending ps_var lie_var))
+        * Typecheck the body, and throw away the elaborated result
+        * Nested splices (which must be typed) are typechecked, and
+          the results accumulated in ps_var; their constraints
+          accumulate in lie_var
+        * Result is a HsTcBracketOut rn_brack pending_splices
+          where rn_brack is the incoming renamed bracket
+
+The life cycle of a un-typed bracket:
+   * Starts as HsBracket
+
+   * When renaming:
+        * Set the ThStage to (Brack s (RnPendingUntyped ps_var))
+        * Rename the body
+        * Nested splices (which must be untyped) are renamed, and the
+          results accumulated in ps_var
+        * Result is still (HsRnBracketOut rn_body pending_splices)
+
+   * When typechecking a HsRnBracketOut
+        * Typecheck the pending_splices individually
+        * Ignore the body of the bracket; just check that the context
+          expects a bracket of that type (e.g. a [p| pat |] bracket should
+          be in a context needing a (Q Pat)
+        * Result is a HsTcBracketOut rn_brack pending_splices
+          where rn_brack is the incoming renamed bracket
+
+
+In both cases, desugaring happens like this:
+  * HsTcBracketOut is desugared by DsMeta.dsBracket.  It
 
       a) Extends the ds_meta environment with the PendingSplices
          attached to the bracket
@@ -189,17 +223,6 @@ quite differently.
     ${n}(e).  The name is initialised to an (Unqual "splice") when the
     splice is created; the renamer gives it a unique.
 
-  * When the type checker type-checks a nested splice ${n}(e), it
-        - typechecks e
-        - adds the typechecked expression (of type (HsExpr Id))
-          as a pending splice to the enclosing bracket
-        - returns something non-committal
-    Eg for [| f ${n}(g x) |], the typechecker
-        - attaches the typechecked term (g x) to the pending splices for n
-          in the outer bracket
-        - returns a non-committal type \alpha.
-        Remember that the bracket discards the typechecked term altogether
-
   * When DsMeta (used to desugar the body of the bracket) comes across
     a splice, it looks up the splice's Name, n, in the ds_meta envt,
     to find an (HsExpr Id) that should be substituted for the splice;
@@ -307,98 +330,77 @@ When a variable is used, we compare
 
 \begin{code}
 -- See Note [How brackets and nested splices are handled]
-tcBracket brack ps res_ty
+-- tcTypedBracket :: HsBracket Name -> TcRhoType -> TcM (HsExpr TcId)
+tcTypedBracket brack@(TExpBr expr) res_ty
   = addErrCtxt (quotationCtxtDoc brack) $
     do { cur_stage <- getStage
-         -- Check for nested brackets
-       ; case cur_stage of
-           { Splice True  -> checkTc (isTypedBracket brack) illegalUntypedBracket
-           ; Splice False -> checkTc (not (isTypedBracket brack)) illegalTypedBracket
-           ; Comp         -> return ()
-           ; Brack {}     -> failWithTc illegalBracket
-           }
-
-       -- Brackets are desugared to code that mentions the TH package
-       ; recordThUse
-
-       -- Typecheck expr to make sure it is valid,
-       -- but throw away the results.  We'll type check
-       -- it again when we actually use it.
        ; ps_ref <- newMutVar []
-       ; lie_var <- getConstraintVar
-       ; let brack_stage = Brack (isTypedBracket brack) cur_stage ps_ref lie_var
-       ; setStage brack_stage $
-         tc_bracket brack ps_ref
-       }
-  where
-    tc_bracket :: HsBracket Name -> TcRef [PendingSplice] -> TcM (HsExpr TcId)
-    tc_bracket brack ps_ref
-      | not (isTypedBracket brack)
-      = do { traceTc "tc_bracked untyped" (ppr brack $$ ppr ps)
-           ; mapM_ tcPendingSplice ps
-           ; meta_ty <- tcUntypedBracket brack
-           ; ps' <- readMutVar ps_ref
-           ; co <- unifyType meta_ty res_ty
-           ; traceTc "tc_bracked done untyped" (ppr meta_ty)
-           ; return (mkHsWrapCo co (HsBracketOut brack ps'))
-           }
-
-    tc_bracket (TExpBr expr) ps_ref
-      = do { traceTc "tc_bracked typed" (ppr brack)
-           ; any_ty <- newFlexiTyVarTy openTypeKind
-             -- NC for no context; tcBracket does that
-           ; _ <- tcMonoExprNC expr any_ty
-           ; meta_ty <- tcTExpTy any_ty
-           ; ps' <- readMutVar ps_ref
-           ; co <- unifyType meta_ty res_ty
-           ; texpco <- tcLookupId unsafeTExpCoerceName
-           ; return (mkHsWrapCo co (unLoc (mkHsApp (nlHsTyApp texpco [any_ty]) (noLoc (HsBracketOut brack ps')))))
-           }
-
-    tc_bracket _ _
-      = panic "tc_bracket: Expected untyped splice"
-
-tcUntypedBracket :: HsBracket Name -> TcM TcType
-tcUntypedBracket (VarBr _ _) = tcMetaTy nameTyConName  -- Result type is Var (not Q-monadic)
-tcUntypedBracket (ExpBr _)   = tcMetaTy expQTyConName  -- Result type is ExpQ (= Q Exp)
-tcUntypedBracket (TypBr _)   = tcMetaTy typeQTyConName -- Result type is Type (= Q Typ)
-tcUntypedBracket (DecBrG _)  = tcMetaTy decsQTyConName -- Result type is Q [Dec]
-tcUntypedBracket (PatBr _)   = tcMetaTy patQTyConName  -- Result type is PatQ (= Q Pat)
-tcUntypedBracket (DecBrL _)  = panic "tcUntypedBracket: Unexpected DecBrL"
-tcUntypedBracket (TExpBr _)  = panic "tcUntypedBracket: Unexpected TExpBr"
-
-tcPendingSplice :: PendingSplice -> TcM ()
-tcPendingSplice (PendingRnExpSplice n expr) 
-  = do { res_ty <- newFlexiTyVarTy openTypeKind
-       ; _ <- tcSpliceExpr (HsSplice False n expr) res_ty
-       ; return ()
-       }
-
-tcPendingSplice (PendingRnPatSplice n expr) 
-  = do { res_ty <- newFlexiTyVarTy openTypeKind
-       ; _ <- tcSplicePat (HsSplice False n expr) res_ty
-       ; return ()
-       }
+       ; lie_var <- getConstraintVar   -- Any constraints arising from nested splices
+                                       -- should get thrown into the constraint set
+                                       -- from outside the bracket
 
-tcPendingSplice (PendingRnCrossStageSplice n) 
-  = do { res_ty <- newFlexiTyVarTy openTypeKind
-       ; _ <- tcCheckId n res_ty
-       ; return ()
-       }
+       -- 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'))  }
 
-tcPendingSplice (PendingRnTypeSplice n expr) 
-  = do { _ <- tcSpliceType (HsSplice False n expr) emptyFVs
-       ; return ()
-       }
+---------------
+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 (PendingRnDeclSplice n expr) 
-  = do { _ <- tcSpliceDecls (HsSplice False n expr)
-       ; return ()
-       }
+---------------
+tcPendingSplice :: PendingRnSplice -> TcM PendingTcSplice
+tcPendingSplice (PendingRnExpSplice (HsSplice n expr))
+  = do { res_ty <- tcMetaTy expQTyConName
+       ; tc_pending_splice n expr res_ty }
+tcPendingSplice (PendingRnPatSplice (HsSplice n expr))
+  = do { res_ty <- tcMetaTy patQTyConName
+       ; tc_pending_splice n expr res_ty }
+tcPendingSplice (PendingRnTypeSplice (HsSplice n expr))
+  = do { res_ty <- tcMetaTy typeQTyConName
+       ; tc_pending_splice n expr res_ty }
+tcPendingSplice (PendingRnDeclSplice (HsSplice n expr))
+  = do { res_ty <- tcMetaTy decsQTyConName
+       ; tc_pending_splice n expr res_ty }
+
+tcPendingSplice (PendingRnCrossStageSplice n)
+  -- Behave like $(lift x); not very pretty
+  = do { res_ty <- tcMetaTy expQTyConName
+       ; tc_pending_splice n (nlHsApp (nlHsVar liftName) (nlHsVar n)) res_ty }
 
-tcPendingSplice (PendingTcSplice _ expr) 
-  = pprPanic "tcPendingSplice: PendingTcSplice" (ppr expr)
+---------------
+tc_pending_splice :: Name -> LHsExpr Name -> TcRhoType -> TcM PendingTcSplice
+tc_pending_splice splice_name expr res_ty
+  = do { expr' <- tcMonoExpr expr res_ty
+       ; return (splice_name, expr') }
 
+---------------
 -- Takes a type tau and returns the type Q (TExp tau)
 tcTExpTy :: TcType -> TcM TcType
 tcTExpTy tau = do
@@ -415,58 +417,35 @@ tcTExpTy tau = do
 %************************************************************************
 
 \begin{code}
-tcSpliceExpr splice@(HsSplice isTypedSplice name expr) res_ty
-  = addErrCtxt (spliceCtxtDoc splice) $
+tcSpliceExpr is_typed splice@(HsSplice name expr) res_ty
+  = ASSERT2( is_typed, ppr splice ) 
+    addErrCtxt (spliceCtxtDoc splice) $
     setSrcSpan (getLoc expr)    $ do
     { stage <- getStage
     ; case stage of
-        { Splice {} | not isTypedSplice -> pprPanic "tcSpliceExpr: encountered unexpanded top-level untyped splice" (ppr splice)
-        ; Comp {}   | not isTypedSplice -> pprPanic "tcSpliceExpr: encountered unexpanded top-level untyped splice" (ppr splice)
-        ; Splice {} -> tcTopSplice expr res_ty
-        ; Comp      -> tcTopSplice expr res_ty
-        ; Brack isTypedBrack pop_stage ps_var lie_var -> do
-
-     { when (isTypedBrack && not isTypedSplice) $
-           failWithTc illegalUntypedSplice
-     ; when (not isTypedBrack && isTypedSplice) $
-           failWithTc illegalTypedSplice
-
-     ; tc_splice_expr isTypedSplice pop_stage ps_var lie_var
-
-       -- The returned expression is ignored
-     ; return (panic "tcSpliceExpr")    
-     }}}
-  where
-    tc_splice_expr :: Bool
-                   -> ThStage -> TcRef [PendingSplice] -> TcRef WantedConstraints
-                   -> TcM ()
+        Splice {}            -> tcTopSplice expr res_ty
+        Comp                 -> tcTopSplice expr res_ty
+        Brack pop_stage pend -> tcNestedSplice pop_stage pend name expr res_ty }
+
+tcNestedSplice :: ThStage -> PendingStuff -> Name
+                -> LHsExpr Name -> TcRhoType -> TcM (HsExpr Id)
     -- See Note [How brackets and nested splices are handled]
     -- A splice inside brackets
-    -- NB: ignore res_ty, apart from zapping it to a mono-type
-    -- e.g.   [| reverse $(h 4) |]
-    -- Here (h 4) :: Q Exp
-    -- but $(h 4) :: forall a.a     i.e. anything!
-    tc_splice_expr False pop_stage ps_var lie_var
-      = do { meta_exp_ty <- tcMetaTy expQTyConName
-           ; expr' <- setStage pop_stage $
-                      setConstraintVar lie_var $
-                      tcMonoExpr expr meta_exp_ty
-           ; ps <- readMutVar ps_var
-           ; writeMutVar ps_var (PendingTcSplice name expr' : ps)
-           ; return ()
-           }
-
-    tc_splice_expr True pop_stage ps_var lie_var
-      = do { meta_exp_ty <- tcTExpTy res_ty
-           ; expr' <- setStage pop_stage $
-                      setConstraintVar lie_var $
-                      tcMonoExpr expr meta_exp_ty
-           ; untypeq <- tcLookupId unTypeQName
-           ; let expr'' = mkHsApp (nlHsTyApp untypeq [res_ty]) expr'
-           ; ps <- readMutVar ps_var
-           ; writeMutVar ps_var (PendingTcSplice name expr'' : ps)
-           ; return ()
-           }
+tcNestedSplice pop_stage (TcPending ps_var lie_var) splice_name expr res_ty
+  = do { meta_exp_ty <- tcTExpTy res_ty
+       ; expr' <- setStage pop_stage $
+                  setConstraintVar lie_var $
+                  tcMonoExpr expr meta_exp_ty
+       ; untypeq <- tcLookupId unTypeQName
+       ; let expr'' = mkHsApp (nlHsTyApp untypeq [res_ty]) expr'
+       ; ps <- readMutVar ps_var
+       ; writeMutVar ps_var ((splice_name, expr'') : ps)
+
+       -- The returned expression is ignored; it's in the pending splices
+       ; return (panic "tcSpliceExpr") }
+
+tcNestedSplice _ _ splice_name _ _
+  = pprPanic "tcNestedSplice: rename stage found" (ppr splice_name)
 
 tcTopSplice :: LHsExpr Name -> TcRhoType -> TcM (HsExpr Id)
 tcTopSplice expr res_ty
@@ -496,31 +475,8 @@ tcTopSplice expr res_ty
 %************************************************************************
 
 \begin{code}
-tcSplicePat   :: HsSplice Name -> TcRhoType -> TcM (HsExpr TcId)
-tcSplicePat splice@(HsSplice True  _ _) _
-  = pprPanic "tcSplicePat: encountered typed pattern splice" (ppr splice)
-
-tcSplicePat splice@(HsSplice False name expr) _
-  = addErrCtxt (spliceCtxtDoc splice) $
-    setSrcSpan (getLoc expr)    $ do
-    { stage <- getStage
-    ; case stage of
-        { Splice {} -> pprPanic "tcSplicePat: encountered unexpanded top-level untyped splice" (ppr splice)
-        ; Comp      -> pprPanic "tcSplicePat: encountered unexpanded top-level untyped splice" (ppr splice)
-        ; Brack isTypedBrack pop_stage ps_var lie_var -> do
-
-     { checkTc (not isTypedBrack) illegalUntypedSplice
-
-     ; meta_exp_ty <- tcMetaTy patQTyConName
-     ; expr' <- setStage pop_stage $
-                setConstraintVar lie_var $
-                tcMonoExpr expr meta_exp_ty
-     ; ps <- readMutVar ps_var
-     ; writeMutVar ps_var (PendingTcSplice name expr' : ps)
-
-       -- The returned expression is ignored
-     ; return (panic "tcSplicePat")    
-     }}}
+tcSpliceDecls splice
+  = pprPanic "tcSpliceDecls: encountered a typed type splice" (ppr splice)
 \end{code}
 
 %************************************************************************
@@ -587,79 +543,6 @@ We don't want the type checker to see these bogus unbound variables.
 
 %************************************************************************
 %*                                                                      *
-                Splicing a type
-%*                                                                      *
-%************************************************************************
-
-Very like splicing an expression, but we don't yet share code.
-
-\begin{code}
-tcSpliceType  :: HsSplice Name -> FreeVars -> TcM (TcType, TcKind)
-tcSpliceType splice@(HsSplice True _ _) _
-  = pprPanic "tcSpliceType: encountered a typed type splice" (ppr splice)
-
-tcSpliceType splice@(HsSplice False name expr) _
-  = setSrcSpan (getLoc expr) $ do
-    { stage <- getStage
-    ; case stage of
-        { Brack isTypedBrack pop_stage ps_var lie_var -> do
-
-         -- See Note [How brackets and nested splices are handled]
-         -- A splice inside brackets
-    { meta_ty <- tcMetaTy typeQTyConName
-    ; when isTypedBrack $
-          failWithTc illegalUntypedSplice
-
-    ; expr' <- setStage pop_stage $
-               setConstraintVar lie_var $
-               tcMonoExpr expr meta_ty
-
-        -- Write the pending splice into the bucket
-    ; ps <- readMutVar ps_var
-    ; writeMutVar ps_var (PendingTcSplice name expr' : ps)
-
-    -- e.g.   [| f (g :: Int -> $(h 4)) |]
-    -- Here (h 4) :: Q Type
-    -- but $(h 4) :: a  i.e. any type, of any kind
-
-    ; kind <- newMetaKindVar
-    ; ty <- newFlexiTyVarTy kind
-    ; return (ty, kind)
-    }
-
-        ; _ -> pprPanic "tcSpliceType: encountered unexpanded top-level type splice" (ppr splice)
-    }}
-\end{code}
-
-%************************************************************************
-%*                                                                      *
-\subsection{Splicing an expression}
-%*                                                                      *
-%************************************************************************
-
-\begin{code}
--- Note [How top-level splices are handled]
--- Always at top level
--- Type sig at top of file:
---      tcSpliceDecls :: LHsExpr Name -> TcM [LHsDecl RdrName]
-tcSpliceDecls splice@(HsSplice True _ _)
-  = pprPanic "tcSpliceDecls: encountered a typed type splice" (ppr splice)
-
-tcSpliceDecls (HsSplice False _ expr)
-  = do  { list_q <- tcMetaTy decsQTyConName     -- Q [Dec]
-        ; zonked_q_expr <- tcTopSpliceExpr False (tcMonoExpr expr list_q)
-
-                -- Run the expression
-        ; decls <- runMetaD zonked_q_expr
-        ; showSplice "declarations" expr
-                     (ppr (getLoc expr) $$ (vcat (map ppr decls)))
-
-        ; return decls }
-\end{code}
-
-
-%************************************************************************
-%*                                                                      *
         Annotations
 %*                                                                      *
 %************************************************************************
@@ -1061,7 +944,7 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where
         = bindName name
       checkTopDecl _
         = addErr $ text "Only function, value, and foreign import declarations may be added with addTopDecl"
-      
+
       bindName :: RdrName -> TcM ()
       bindName (Exact n)
         = do { th_topnames_var <- fmap tcg_th_topnames getGblEnv
@@ -1108,21 +991,6 @@ showSplice what before after
                             nest 2 (sep [nest 2 (ppr before),
                                          text "======>",
                                          nest 2 after])]) }
-
-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")
 \end{code}
 
 
diff --git a/compiler/typecheck/TcSplice.lhs-boot b/compiler/typecheck/TcSplice.lhs-boot
index 07ba144958..b96cf18311 100644
--- a/compiler/typecheck/TcSplice.lhs-boot
+++ b/compiler/typecheck/TcSplice.lhs-boot
@@ -2,7 +2,7 @@
 module TcSplice where
 import HsSyn    ( HsSplice, HsBracket, HsQuasiQuote,
                   HsExpr, LHsType, LHsExpr, LPat, LHsDecl )
-import HsExpr   ( PendingSplice )
+import HsExpr   ( PendingRnSplice )
 import Id       ( Id )
 import Name     ( Name )
 import RdrName  ( RdrName )
@@ -14,16 +14,19 @@ import Annotations ( Annotation, CoreAnnTarget )
 import qualified Language.Haskell.TH as TH
 #endif
 
-tcSpliceExpr :: HsSplice Name
+tcSpliceExpr :: Bool -> HsSplice Name
              -> TcRhoType
              -> TcM (HsExpr TcId)
 
 tcSpliceDecls :: HsSplice Name -> TcM [LHsDecl RdrName]
 
-tcBracket :: HsBracket Name 
-          -> [PendingSplice]
-          -> TcRhoType
-          -> TcM (HsExpr TcId)
+tcUntypedBracket :: HsBracket Name
+                 -> [PendingRnSplice]
+                 -> TcRhoType
+                 -> TcM (HsExpr TcId)
+tcTypedBracket :: HsBracket Name
+               -> TcRhoType
+               -> TcM (HsExpr TcId)
 
 tcTopSpliceExpr :: Bool -> TcM (LHsExpr Id) -> TcM (LHsExpr Id)