-pprStmt (BindStmt pat expr _) = hsep [ppr pat, ptext SLIT("<-"), ppr expr]
-pprStmt (LetStmt binds) = hsep [ptext SLIT("let"), pprBinds binds]
-pprStmt (ExprStmt expr _ _) = ppr expr
-pprStmt (ResultStmt expr _) = ppr expr
-pprStmt (ParStmt stmtss)
- = hsep (map (\stmts -> ptext SLIT("| ") <> ppr stmts) stmtss)
-pprStmt (ParStmtOut stmtss)
- = hsep (map (\stmts -> ptext SLIT("| ") <> ppr stmts) stmtss)
-
-pprDo :: (Outputable id, Outputable pat)
- => HsDoContext -> [Stmt id pat] -> SDoc
-pprDo DoExpr stmts = hang (ptext SLIT("do")) 2 (vcat (map ppr stmts))
-pprDo ListComp stmts = pprComp brackets stmts
-pprDo PArrComp stmts = pprComp pabrackets stmts
-
-pprComp :: (Outputable id, Outputable pat)
- => (SDoc -> SDoc) -> [Stmt id pat] -> SDoc
-pprComp brack stmts = brack $
- hang (pprExpr expr <+> char '|')
- 4 (interpp'SP quals)
- where
- ResultStmt expr _ = last stmts -- Last stmt should
- quals = init stmts -- be an ResultStmt
+pprStmt (BindStmt pat expr _ _) = hsep [ppr pat, ptext SLIT("<-"), ppr expr]
+pprStmt (LetStmt binds) = hsep [ptext SLIT("let"), pprBinds binds]
+pprStmt (ExprStmt expr _ _) = ppr expr
+pprStmt (ParStmt stmtss) = hsep (map (\stmts -> ptext SLIT("| ") <> ppr stmts) stmtss)
+pprStmt (RecStmt segment _ _ _ _) = ptext SLIT("rec") <+> braces (vcat (map ppr segment))
+
+pprDo :: OutputableBndr id => HsStmtContext any -> [LStmt id] -> LHsExpr id -> SDoc
+pprDo DoExpr stmts body = hang (ptext SLIT("do")) 2 (vcat (map ppr stmts) $$ ppr body)
+pprDo (MDoExpr _) stmts body = hang (ptext SLIT("mdo")) 3 (vcat (map ppr stmts) $$ ppr body)
+pprDo ListComp stmts body = pprComp brackets stmts body
+pprDo PArrComp stmts body = pprComp pa_brackets stmts body
+
+pprComp :: OutputableBndr id => (SDoc -> SDoc) -> [LStmt id] -> LHsExpr id -> SDoc
+pprComp brack quals body
+ = brack $
+ hang (ppr body <+> char '|')
+ 4 (interpp'SP quals)
+\end{code}
+
+%************************************************************************
+%* *
+ Template Haskell quotation brackets
+%* *
+%************************************************************************
+
+\begin{code}
+data HsSplice id = HsSplice -- $z or $(f 4)
+ id -- The id is just a unique name to
+ (LHsExpr id) -- identify this splice point
+
+instance OutputableBndr id => Outputable (HsSplice id) where
+ ppr = pprSplice
+
+pprSplice :: OutputableBndr id => HsSplice id -> SDoc
+pprSplice (HsSplice n e) = char '$' <> brackets (ppr n) <> pprParendExpr e
+
+
+data HsBracket id = ExpBr (LHsExpr id) -- [| expr |]
+ | PatBr (LPat id) -- [p| pat |]
+ | DecBr (HsGroup id) -- [d| decls |]
+ | TypBr (LHsType id) -- [t| type |]
+ | VarBr id -- 'x, ''T
+
+instance OutputableBndr id => Outputable (HsBracket id) where
+ ppr = pprHsBracket
+
+
+pprHsBracket (ExpBr e) = thBrackets empty (ppr e)
+pprHsBracket (PatBr p) = thBrackets (char 'p') (ppr p)
+pprHsBracket (DecBr d) = thBrackets (char 'd') (ppr d)
+pprHsBracket (TypBr t) = thBrackets (char 't') (ppr t)
+pprHsBracket (VarBr n) = char '\'' <> ppr n
+ -- Infelicity: can't show ' vs '', because
+ -- we can't ask n what its OccName is, because the
+ -- pretty-printer for HsExpr doesn't ask for NamedThings
+ -- But the pretty-printer for names will show the OccName class
+
+thBrackets pp_kind pp_body = char '[' <> pp_kind <> char '|' <+>
+ pp_body <+> ptext SLIT("|]")