TTG3 Combined Step 1 and 3 for Trees That Grow

Further progress on implementing Trees that Grow on hsSyn AST.

See https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow

Trees that grow extension points are added for
  - Rest of HsExpr.hs

Updates haddock submodule

Test Plan: ./validate

Reviewers: bgamari, shayan-najd, goldfire

Subscribers: goldfire, rwbarton, thomie, mpickering

Differential Revision: https://phabricator.haskell.org/D4186

4 files changed, 93 insertions, 80 deletions

diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs
index 2d4ec89cc7..8f719c4b0c 100644
--- a/compiler/rename/RnExpr.hs
+++ b/compiler/rename/RnExpr.hs
@@ -282,10 +282,11 @@ rnExpr (ExplicitTuple x tup_args boxity)
        ; (tup_args', fvs) <- mapAndUnzipM rnTupArg tup_args
        ; return (ExplicitTuple x tup_args' boxity, plusFVs fvs) }
   where
-    rnTupArg (L l (Present e)) = do { (e',fvs) <- rnLExpr e
-                                    ; return (L l (Present e'), fvs) }
-    rnTupArg (L l (Missing _)) = return (L l (Missing placeHolderType)
+    rnTupArg (L l (Present x e)) = do { (e',fvs) <- rnLExpr e
+                                      ; return (L l (Present x e'), fvs) }
+    rnTupArg (L l (Missing _)) = return (L l (Missing noExt)
                                         , emptyFVs)
+    rnTupArg (L _ (XTupArg {})) = panic "rnExpr.XTupArg"
 
 rnExpr (ExplicitSum x alt arity expr)
   = do { (expr', fvs) <- rnLExpr expr
@@ -465,26 +466,26 @@ rnCmdArgs (arg:args)
 rnCmdTop :: LHsCmdTop GhcPs -> RnM (LHsCmdTop GhcRn, FreeVars)
 rnCmdTop = wrapLocFstM rnCmdTop'
  where
-  rnCmdTop' (HsCmdTop cmd _ _ _)
+  rnCmdTop' (HsCmdTop _ cmd)
    = do { (cmd', fvCmd) <- rnLCmd cmd
         ; let cmd_names = [arrAName, composeAName, firstAName] ++
                           nameSetElemsStable (methodNamesCmd (unLoc cmd'))
         -- Generate the rebindable syntax for the monad
         ; (cmd_names', cmd_fvs) <- lookupSyntaxNames cmd_names
 
-        ; return (HsCmdTop cmd' placeHolderType placeHolderType
-                  (cmd_names `zip` cmd_names'),
+        ; return (HsCmdTop (cmd_names `zip` cmd_names') cmd',
                   fvCmd `plusFV` cmd_fvs) }
+  rnCmdTop' (XCmdTop{}) = panic "rnCmdTop"
 
 rnLCmd :: LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
 rnLCmd = wrapLocFstM rnCmd
 
 rnCmd :: HsCmd GhcPs -> RnM (HsCmd GhcRn, FreeVars)
 
-rnCmd (HsCmdArrApp arrow arg _ ho rtl)
+rnCmd (HsCmdArrApp x arrow arg ho rtl)
   = do { (arrow',fvArrow) <- select_arrow_scope (rnLExpr arrow)
        ; (arg',fvArg) <- rnLExpr arg
-       ; return (HsCmdArrApp arrow' arg' placeHolderType ho rtl,
+       ; return (HsCmdArrApp x arrow' arg' ho rtl,
                  fvArrow `plusFV` fvArg) }
   where
     select_arrow_scope tc = case ho of
@@ -497,7 +498,7 @@ rnCmd (HsCmdArrApp arrow arg _ ho rtl)
         -- inside 'arrow'.  In the higher-order case (-<<), they are.
 
 -- infix form
-rnCmd (HsCmdArrForm op _ (Just _) [arg1, arg2])
+rnCmd (HsCmdArrForm _ op _ (Just _) [arg1, arg2])
   = do { (op',fv_op) <- escapeArrowScope (rnLExpr op)
        ; let L _ (HsVar _ (L _ op_name)) = op'
        ; (arg1',fv_arg1) <- rnCmdTop arg1
@@ -507,47 +508,48 @@ rnCmd (HsCmdArrForm op _ (Just _) [arg1, arg2])
        ; final_e <- mkOpFormRn arg1' op' fixity arg2'
        ; return (final_e, fv_arg1 `plusFV` fv_op `plusFV` fv_arg2) }
 
-rnCmd (HsCmdArrForm op f fixity cmds)
+rnCmd (HsCmdArrForm x op f fixity cmds)
   = do { (op',fvOp) <- escapeArrowScope (rnLExpr op)
        ; (cmds',fvCmds) <- rnCmdArgs cmds
-       ; return (HsCmdArrForm op' f fixity cmds', fvOp `plusFV` fvCmds) }
+       ; return (HsCmdArrForm x op' f fixity cmds', fvOp `plusFV` fvCmds) }
 
-rnCmd (HsCmdApp fun arg)
+rnCmd (HsCmdApp x fun arg)
   = do { (fun',fvFun) <- rnLCmd  fun
        ; (arg',fvArg) <- rnLExpr arg
-       ; return (HsCmdApp fun' arg', fvFun `plusFV` fvArg) }
+       ; return (HsCmdApp x fun' arg', fvFun `plusFV` fvArg) }
 
-rnCmd (HsCmdLam matches)
+rnCmd (HsCmdLam x matches)
   = do { (matches', fvMatch) <- rnMatchGroup LambdaExpr rnLCmd matches
-       ; return (HsCmdLam matches', fvMatch) }
+       ; return (HsCmdLam x matches', fvMatch) }
 
-rnCmd (HsCmdPar e)
+rnCmd (HsCmdPar x e)
   = do  { (e', fvs_e) <- rnLCmd e
-        ; return (HsCmdPar e', fvs_e) }
+        ; return (HsCmdPar x e', fvs_e) }
 
-rnCmd (HsCmdCase expr matches)
+rnCmd (HsCmdCase x expr matches)
   = do { (new_expr, e_fvs) <- rnLExpr expr
        ; (new_matches, ms_fvs) <- rnMatchGroup CaseAlt rnLCmd matches
-       ; return (HsCmdCase new_expr new_matches, e_fvs `plusFV` ms_fvs) }
+       ; return (HsCmdCase x new_expr new_matches, e_fvs `plusFV` ms_fvs) }
 
-rnCmd (HsCmdIf _ p b1 b2)
+rnCmd (HsCmdIf x _ p b1 b2)
   = do { (p', fvP) <- rnLExpr p
        ; (b1', fvB1) <- rnLCmd b1
        ; (b2', fvB2) <- rnLCmd b2
        ; (mb_ite, fvITE) <- lookupIfThenElse
-       ; return (HsCmdIf mb_ite p' b1' b2', plusFVs [fvITE, fvP, fvB1, fvB2]) }
+       ; return (HsCmdIf x mb_ite p' b1' b2', plusFVs [fvITE, fvP, fvB1, fvB2])}
 
-rnCmd (HsCmdLet (L l binds) cmd)
+rnCmd (HsCmdLet x (L l binds) cmd)
   = rnLocalBindsAndThen binds $ \ binds' _ -> do
       { (cmd',fvExpr) <- rnLCmd cmd
-      ; return (HsCmdLet (L l binds') cmd', fvExpr) }
+      ; return (HsCmdLet x (L l binds') cmd', fvExpr) }
 
-rnCmd (HsCmdDo (L l stmts) _)
+rnCmd (HsCmdDo x (L l stmts))
   = do  { ((stmts', _), fvs) <-
             rnStmts ArrowExpr rnLCmd stmts (\ _ -> return ((), emptyFVs))
-        ; return ( HsCmdDo (L l stmts') placeHolderType, fvs ) }
+        ; return ( HsCmdDo x (L l stmts'), fvs ) }
 
 rnCmd cmd@(HsCmdWrap {}) = pprPanic "rnCmd" (ppr cmd)
+rnCmd cmd@(XCmd {})      = pprPanic "rnCmd" (ppr cmd)
 
 ---------------------------------------------------
 type CmdNeeds = FreeVars        -- Only inhabitants are
@@ -559,26 +561,28 @@ methodNamesLCmd = methodNamesCmd . unLoc
 
 methodNamesCmd :: HsCmd GhcRn -> CmdNeeds
 
-methodNamesCmd (HsCmdArrApp _arrow _arg _ HsFirstOrderApp _rtl)
+methodNamesCmd (HsCmdArrApp _ _arrow _arg HsFirstOrderApp _rtl)
   = emptyFVs
-methodNamesCmd (HsCmdArrApp _arrow _arg _ HsHigherOrderApp _rtl)
+methodNamesCmd (HsCmdArrApp _ _arrow _arg HsHigherOrderApp _rtl)
   = unitFV appAName
 methodNamesCmd (HsCmdArrForm {}) = emptyFVs
-methodNamesCmd (HsCmdWrap _ cmd) = methodNamesCmd cmd
+methodNamesCmd (HsCmdWrap _ _ cmd) = methodNamesCmd cmd
 
-methodNamesCmd (HsCmdPar c) = methodNamesLCmd c
+methodNamesCmd (HsCmdPar _ c) = methodNamesLCmd c
 
-methodNamesCmd (HsCmdIf _ _ c1 c2)
+methodNamesCmd (HsCmdIf _ _ _ c1 c2)
   = methodNamesLCmd c1 `plusFV` methodNamesLCmd c2 `addOneFV` choiceAName
 
-methodNamesCmd (HsCmdLet _ c)          = methodNamesLCmd c
-methodNamesCmd (HsCmdDo (L _ stmts) _) = methodNamesStmts stmts
-methodNamesCmd (HsCmdApp c _)          = methodNamesLCmd c
-methodNamesCmd (HsCmdLam match)        = methodNamesMatch match
+methodNamesCmd (HsCmdLet _ _ c)          = methodNamesLCmd c
+methodNamesCmd (HsCmdDo _ (L _ stmts))   = methodNamesStmts stmts
+methodNamesCmd (HsCmdApp _ c _)          = methodNamesLCmd c
+methodNamesCmd (HsCmdLam _ match)        = methodNamesMatch match
 
-methodNamesCmd (HsCmdCase _ matches)
+methodNamesCmd (HsCmdCase _ _ matches)
   = methodNamesMatch matches `addOneFV` choiceAName
 
+methodNamesCmd (XCmd {}) = panic "methodNamesCmd"
+
 --methodNamesCmd _ = emptyFVs
    -- Other forms can't occur in commands, but it's not convenient
    -- to error here so we just do what's convenient.
@@ -862,7 +866,7 @@ rnStmt ctxt rnBody (L loc (BindStmt pat body _ _ _)) thing_inside
 
         ; rnPat (StmtCtxt ctxt) pat $ \ pat' -> do
         { (thing, fvs3) <- thing_inside (collectPatBinders pat')
-        ; return (( [( L loc (BindStmt pat' body' bind_op fail_op PlaceHolder)
+        ; return (( [( L loc (BindStmt pat' body' bind_op fail_op placeHolder)
                      , fv_expr )]
                   , thing),
                   fv_expr `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) }}
@@ -945,7 +949,7 @@ rnStmt ctxt _ (L loc (TransStmt { trS_stmts = stmts, trS_by = by, trS_form = for
        ; return (([(L loc (TransStmt { trS_stmts = stmts', trS_bndrs = bndr_map
                                     , trS_by = by', trS_using = using', trS_form = form
                                     , trS_ret = return_op, trS_bind = bind_op
-                                    , trS_bind_arg_ty = PlaceHolder
+                                    , trS_bind_arg_ty = placeHolder
                                     , trS_fmap = fmap_op }), fvs2)], thing), all_fvs) }
 
 rnStmt _ _ (L _ ApplicativeStmt{}) _ =
@@ -970,7 +974,7 @@ rnParallelStmts ctxt return_op segs thing_inside
            ; (thing, fvs) <- bindLocalNames bndrs' (thing_inside bndrs')
            ; return (([], thing), fvs) }
 
-    rn_segs env bndrs_so_far (ParStmtBlock stmts _ _ : segs)
+    rn_segs env bndrs_so_far (ParStmtBlock x stmts _ _ : segs)
       = do { ((stmts', (used_bndrs, segs', thing)), fvs)
                     <- rnStmts ctxt rnLExpr stmts $ \ bndrs ->
                        setLocalRdrEnv env       $ do
@@ -978,8 +982,9 @@ rnParallelStmts ctxt return_op segs thing_inside
                        ; let used_bndrs = filter (`elemNameSet` fvs) bndrs
                        ; return ((used_bndrs, segs', thing), fvs) }
 
-           ; let seg' = ParStmtBlock stmts' used_bndrs return_op
+           ; let seg' = ParStmtBlock x stmts' used_bndrs return_op
            ; return ((seg':segs', thing), fvs) }
+    rn_segs _ _ (XParStmtBlock{}:_) = panic "rnParallelStmts"
 
     cmpByOcc n1 n2 = nameOccName n1 `compare` nameOccName n2
     dupErr vs = addErr (text "Duplicate binding in parallel list comprehension for:"
@@ -1195,7 +1200,7 @@ rn_rec_stmt rnBody _ (L loc (BindStmt pat' body _ _ _), fv_pat)
        ; let bndrs = mkNameSet (collectPatBinders pat')
              fvs   = fv_expr `plusFV` fv_pat `plusFV` fvs1 `plusFV` fvs2
        ; return [(bndrs, fvs, bndrs `intersectNameSet` fvs,
-                  L loc (BindStmt pat' body' bind_op fail_op PlaceHolder))] }
+                  L loc (BindStmt pat' body' bind_op fail_op placeHolder))] }
 
 rn_rec_stmt _ _ (L _ (LetStmt (L _ binds@(HsIPBinds _))), _)
   = failWith (badIpBinds (text "an mdo expression") binds)
diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs
index 1057cd2dbe..7d31a87ad3 100644
--- a/compiler/rename/RnPat.hs
+++ b/compiler/rename/RnPat.hs
@@ -385,7 +385,7 @@ rnLPatAndThen :: NameMaker -> LPat GhcPs -> CpsRn (LPat GhcRn)
 rnLPatAndThen nm lpat = wrapSrcSpanCps (rnPatAndThen nm) lpat
 
 rnPatAndThen :: NameMaker -> Pat GhcPs -> CpsRn (Pat GhcRn)
-rnPatAndThen _  (WildPat _)   = return (WildPat placeHolderType)
+rnPatAndThen _  (WildPat _)   = return (WildPat noExt)
 rnPatAndThen mk (ParPat x pat)  = do { pat' <- rnLPatAndThen mk pat
                                      ; return (ParPat x pat') }
 rnPatAndThen mk (LazyPat x pat) = do { pat' <- rnLPatAndThen mk pat
@@ -500,8 +500,8 @@ rnPatAndThen mk (SumPat x pat alt arity)
        }
 
 -- If a splice has been run already, just rename the result.
-rnPatAndThen mk (SplicePat x (HsSpliced mfs (HsSplicedPat pat)))
-  = SplicePat x . HsSpliced mfs . HsSplicedPat <$> rnPatAndThen mk pat
+rnPatAndThen mk (SplicePat x (HsSpliced x2 mfs (HsSplicedPat pat)))
+  = SplicePat x . HsSpliced x2 mfs . HsSplicedPat <$> rnPatAndThen mk pat
 
 rnPatAndThen mk (SplicePat _ splice)
   = do { eith <- liftCpsFV $ rnSplicePat splice
diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs
index d18657b55e..fc7240ef44 100644
--- a/compiler/rename/RnSplice.hs
+++ b/compiler/rename/RnSplice.hs
@@ -114,7 +114,7 @@ rnBracket e br_body
        }
 
 rn_bracket :: ThStage -> HsBracket GhcPs -> RnM (HsBracket GhcRn, FreeVars)
-rn_bracket outer_stage br@(VarBr flg rdr_name)
+rn_bracket outer_stage br@(VarBr x flg rdr_name)
   = do { name <- lookupOccRn rdr_name
        ; this_mod <- getModule
 
@@ -136,17 +136,18 @@ rn_bracket outer_stage br@(VarBr flg rdr_name)
                                              (quotedNameStageErr br) }
                         }
                     }
-       ; return (VarBr flg name, unitFV name) }
+       ; return (VarBr x flg name, unitFV name) }
 
-rn_bracket _ (ExpBr e) = do { (e', fvs) <- rnLExpr e
-                            ; return (ExpBr e', fvs) }
+rn_bracket _ (ExpBr x e) = do { (e', fvs) <- rnLExpr e
+                            ; return (ExpBr x e', fvs) }
 
-rn_bracket _ (PatBr p) = rnPat ThPatQuote p $ \ p' -> return (PatBr p', emptyFVs)
+rn_bracket _ (PatBr x p)
+  = rnPat ThPatQuote p $ \ p' -> return (PatBr x p', emptyFVs)
 
-rn_bracket _ (TypBr t) = do { (t', fvs) <- rnLHsType TypBrCtx t
-                            ; return (TypBr t', fvs) }
+rn_bracket _ (TypBr x t) = do { (t', fvs) <- rnLHsType TypBrCtx t
+                              ; return (TypBr x t', fvs) }
 
-rn_bracket _ (DecBrL decls)
+rn_bracket _ (DecBrL x decls)
   = do { group <- groupDecls decls
        ; gbl_env  <- getGblEnv
        ; let new_gbl_env = gbl_env { tcg_dus = emptyDUs }
@@ -158,7 +159,7 @@ rn_bracket _ (DecBrL decls)
               -- Discard the tcg_env; it contains only extra info about fixity
         ; traceRn "rn_bracket dec" (ppr (tcg_dus tcg_env) $$
                    ppr (duUses (tcg_dus tcg_env)))
-        ; return (DecBrG group', duUses (tcg_dus tcg_env)) }
+        ; return (DecBrG x group', duUses (tcg_dus tcg_env)) }
   where
     groupDecls :: [LHsDecl GhcPs] -> RnM (HsGroup GhcPs)
     groupDecls decls
@@ -172,10 +173,12 @@ rn_bracket _ (DecBrL decls)
                   }
            }}
 
-rn_bracket _ (DecBrG _) = panic "rn_bracket: unexpected DecBrG"
+rn_bracket _ (DecBrG {}) = panic "rn_bracket: unexpected DecBrG"
 
-rn_bracket _ (TExpBr e) = do { (e', fvs) <- rnLExpr e
-                             ; return (TExpBr e', fvs) }
+rn_bracket _ (TExpBr x e) = do { (e', fvs) <- rnLExpr e
+                               ; return (TExpBr x e', fvs) }
+
+rn_bracket _ (XBracket {}) = panic "rn_bracket: unexpected XBracket"
 
 quotationCtxtDoc :: HsBracket GhcPs -> SDoc
 quotationCtxtDoc br_body
@@ -293,10 +296,11 @@ runRnSplice flavour run_meta ppr_res splice
   = do { splice' <- getHooked runRnSpliceHook return >>= ($ splice)
 
        ; let the_expr = case splice' of
-                  HsUntypedSplice _ _ e   ->  e
-                  HsQuasiQuote _ q qs str -> mkQuasiQuoteExpr flavour q qs str
-                  HsTypedSplice {}        -> pprPanic "runRnSplice" (ppr splice)
-                  HsSpliced {}            -> pprPanic "runRnSplice" (ppr splice)
+                HsUntypedSplice _ _ _ e   ->  e
+                HsQuasiQuote _ _ q qs str -> mkQuasiQuoteExpr flavour q qs str
+                HsTypedSplice {}          -> pprPanic "runRnSplice" (ppr splice)
+                HsSpliced {}              -> pprPanic "runRnSplice" (ppr splice)
+                XSplice {}                -> pprPanic "runRnSplice" (ppr splice)
 
              -- Typecheck the expression
        ; meta_exp_ty   <- tcMetaTy meta_ty_name
@@ -334,14 +338,16 @@ runRnSplice flavour run_meta ppr_res splice
 makePending :: UntypedSpliceFlavour
             -> HsSplice GhcRn
             -> PendingRnSplice
-makePending flavour (HsUntypedSplice _ n e)
+makePending flavour (HsUntypedSplice _ _ n e)
   = PendingRnSplice flavour n e
-makePending flavour (HsQuasiQuote n quoter q_span quote)
+makePending flavour (HsQuasiQuote _ n quoter q_span quote)
   = PendingRnSplice flavour n (mkQuasiQuoteExpr flavour quoter q_span quote)
 makePending _ splice@(HsTypedSplice {})
   = pprPanic "makePending" (ppr splice)
 makePending _ splice@(HsSpliced {})
   = pprPanic "makePending" (ppr splice)
+makePending _ splice@(XSplice {})
+  = pprPanic "makePending" (ppr splice)
 
 ------------------
 mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString
@@ -365,21 +371,21 @@ mkQuasiQuoteExpr flavour quoter q_span quote
 ---------------------
 rnSplice :: HsSplice GhcPs -> RnM (HsSplice GhcRn, FreeVars)
 -- Not exported...used for all
-rnSplice (HsTypedSplice hasParen splice_name expr)
+rnSplice (HsTypedSplice x hasParen splice_name expr)
   = do  { checkTH expr "Template Haskell typed splice"
         ; loc  <- getSrcSpanM
         ; n' <- newLocalBndrRn (L loc splice_name)
         ; (expr', fvs) <- rnLExpr expr
-        ; return (HsTypedSplice hasParen n' expr', fvs) }
+        ; return (HsTypedSplice x hasParen n' expr', fvs) }
 
-rnSplice (HsUntypedSplice hasParen splice_name expr)
+rnSplice (HsUntypedSplice x hasParen splice_name expr)
   = do  { checkTH expr "Template Haskell untyped splice"
         ; loc  <- getSrcSpanM
         ; n' <- newLocalBndrRn (L loc splice_name)
         ; (expr', fvs) <- rnLExpr expr
-        ; return (HsUntypedSplice hasParen n' expr', fvs) }
+        ; return (HsUntypedSplice x hasParen n' expr', fvs) }
 
-rnSplice (HsQuasiQuote splice_name quoter q_loc quote)
+rnSplice (HsQuasiQuote x splice_name quoter q_loc quote)
   = do  { checkTH quoter "Template Haskell quasi-quote"
         ; loc  <- getSrcSpanM
         ; splice_name' <- newLocalBndrRn (L loc splice_name)
@@ -390,9 +396,11 @@ rnSplice (HsQuasiQuote splice_name quoter q_loc quote)
         ; when (nameIsLocalOrFrom this_mod quoter') $
           checkThLocalName quoter'
 
-        ; return (HsQuasiQuote splice_name' quoter' q_loc quote, unitFV quoter') }
+        ; return (HsQuasiQuote x splice_name' quoter' q_loc quote
+                                                             , unitFV quoter') }
 
 rnSplice splice@(HsSpliced {}) = pprPanic "rnSplice" (ppr splice)
+rnSplice splice@(XSplice {})   = pprPanic "rnSplice" (ppr splice)
 
 ---------------------
 rnSpliceExpr :: HsSplice GhcPs -> RnM (HsExpr GhcRn, FreeVars)
@@ -423,7 +431,7 @@ rnSpliceExpr splice
            ; (lexpr3, fvs) <- checkNoErrs (rnLExpr rn_expr)
              -- See Note [Delaying modFinalizers in untyped splices].
            ; return ( HsPar noExt $ HsSpliceE noExt
-                            . HsSpliced (ThModFinalizers mod_finalizers)
+                            . HsSpliced noExt (ThModFinalizers mod_finalizers)
                             . HsSplicedExpr <$>
                             lexpr3
                     , fvs)
@@ -537,7 +545,7 @@ rnSpliceType splice
                                     -- checkNoErrs: see Note [Renamer errors]
              -- See Note [Delaying modFinalizers in untyped splices].
            ; return ( HsParTy noExt $ HsSpliceTy noExt
-                              . HsSpliced (ThModFinalizers mod_finalizers)
+                              . HsSpliced noExt (ThModFinalizers mod_finalizers)
                               . HsSplicedTy <$>
                               hs_ty3
                     , fvs
@@ -602,9 +610,9 @@ rnSplicePat splice
                 runRnSplice UntypedPatSplice runMetaP ppr rn_splice
              -- See Note [Delaying modFinalizers in untyped splices].
            ; return ( Left $ ParPat noExt $ (SplicePat noExt)
-                                    . HsSpliced (ThModFinalizers mod_finalizers)
-                                    . HsSplicedPat <$>
-                                    pat
+                              . HsSpliced noExt (ThModFinalizers mod_finalizers)
+                              . HsSplicedPat <$>
+                              pat
                     , emptyFVs
                     ) }
               -- Wrap the result of the quasi-quoter in parens so that we don't
@@ -687,6 +695,7 @@ spliceCtxt splice
              HsTypedSplice   {} -> text "typed splice:"
              HsQuasiQuote    {} -> text "quasi-quotation:"
              HsSpliced       {} -> text "spliced expression:"
+             XSplice         {} -> text "spliced expression:"
 
 -- | The splice data to be logged
 data SpliceInfo
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index 14ef4f42a3..2e1b12d8e0 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -1116,7 +1116,7 @@ collectAnonWildCards lty = go lty
                                       `mappend` go ty
       HsQualTy { hst_ctxt = L _ ctxt
                , hst_body = ty }  -> gos ctxt `mappend` go ty
-      HsSpliceTy _ (HsSpliced _ (HsSplicedTy ty)) -> go $ L noSrcSpan ty
+      HsSpliceTy _ (HsSpliced _ _ (HsSplicedTy ty)) -> go $ L noSrcSpan ty
       HsSpliceTy{} -> mempty
       HsTyLit{} -> mempty
       HsTyVar{} -> mempty
@@ -1341,25 +1341,24 @@ mkOpFormRn :: LHsCmdTop GhcRn            -- Left operand; already rearranged
           -> RnM (HsCmd GhcRn)
 
 -- (e11 `op1` e12) `op2` e2
-mkOpFormRn a1@(L loc (HsCmdTop (L _ (HsCmdArrForm op1 f (Just fix1)
-                                     [a11,a12])) _ _ _))
+mkOpFormRn a1@(L loc (HsCmdTop _ (L _ (HsCmdArrForm x op1 f (Just fix1)
+                                     [a11,a12]))))
         op2 fix2 a2
   | nofix_error
   = do precParseErr (get_op op1,fix1) (get_op op2,fix2)
-       return (HsCmdArrForm op2 f (Just fix2) [a1, a2])
+       return (HsCmdArrForm x op2 f (Just fix2) [a1, a2])
 
   | associate_right
   = do new_c <- mkOpFormRn a12 op2 fix2 a2
-       return (HsCmdArrForm op1 f (Just fix1)
-               [a11, L loc (HsCmdTop (L loc new_c)
-               placeHolderType placeHolderType [])])
+       return (HsCmdArrForm noExt op1 f (Just fix1)
+               [a11, L loc (HsCmdTop [] (L loc new_c))])
         -- TODO: locs are wrong
   where
     (nofix_error, associate_right) = compareFixity fix1 fix2
 
 --      Default case
 mkOpFormRn arg1 op fix arg2                     -- Default case, no rearrangment
-  = return (HsCmdArrForm op Infix (Just fix) [arg1, arg2])
+  = return (HsCmdArrForm noExt op Infix (Just fix) [arg1, arg2])
 
 
 --------------------------------------