+pprMatches :: (OutputableBndr id) => HsMatchContext id -> [Match id] -> SDoc
+pprMatches ctxt matches = vcat (map (pprMatch ctxt) matches)
+
+-- Exported to HsBinds, which can't see the defn of HsMatchContext
+pprFunBind :: (OutputableBndr id) => id -> [Match id] -> SDoc
+pprFunBind fun matches = pprMatches (FunRhs fun) matches
+
+-- Exported to HsBinds, which can't see the defn of HsMatchContext
+pprPatBind :: (OutputableBndr id)
+ => Pat id -> GRHSs id -> SDoc
+pprPatBind pat grhss = sep [ppr pat, nest 4 (pprGRHSs PatBindRhs grhss)]
+
+
+pprMatch :: OutputableBndr id => HsMatchContext id -> Match id -> SDoc
+pprMatch ctxt (Match pats maybe_ty grhss)
+ = pp_name ctxt <+> sep [sep (map ppr pats),
+ ppr_maybe_ty,
+ nest 2 (pprGRHSs ctxt grhss)]
+ where
+ pp_name (FunRhs fun) = ppr fun -- Not pprBndr; the AbsBinds will
+ -- have printed the signature
+ pp_name LambdaExpr = char '\\'
+ pp_name other = empty
+
+ ppr_maybe_ty = case maybe_ty of
+ Just ty -> dcolon <+> ppr ty
+ Nothing -> empty
+
+
+pprGRHSs :: OutputableBndr id => HsMatchContext id -> GRHSs id -> SDoc
+pprGRHSs ctxt (GRHSs grhss binds ty)
+ = vcat (map (pprGRHS ctxt) grhss)
+ $$
+ (if nullBinds binds then empty
+ else text "where" $$ nest 4 (pprDeeper (ppr binds)))
+
+
+pprGRHS :: OutputableBndr id => HsMatchContext id -> GRHS id -> SDoc
+
+pprGRHS ctxt (GRHS [ResultStmt expr _] locn)
+ = pp_rhs ctxt expr
+
+pprGRHS ctxt (GRHS guarded locn)
+ = sep [char '|' <+> interpp'SP guards, pp_rhs ctxt expr]
+ where
+ ResultStmt expr _ = last guarded -- Last stmt should be a ResultStmt for guards
+ guards = init guarded
+
+pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
+\end{code}
+
+
+
+%************************************************************************
+%* *
+\subsection{Do stmts and list comprehensions}
+%* *
+%************************************************************************
+
+\begin{code}
+data Stmt id
+ = BindStmt (Pat id) (HsExpr id) SrcLoc
+ | LetStmt (HsBinds id)
+ | ResultStmt (HsExpr id) SrcLoc -- See notes that follow
+ | ExprStmt (HsExpr id) PostTcType SrcLoc -- See notes that follow
+ -- The type is the *element type* of the expression
+
+ -- ParStmts only occur in a list comprehension
+ | ParStmt [([Stmt id], [id])] -- After remaing, the ids are the binders
+ -- bound by the stmts and used subsequently
+
+ -- Recursive statement
+ | RecStmt [Stmt id]
+ --- The next two fields are only valid after renaming
+ [id] -- The ids are a subset of the variables bound by the stmts
+ -- that are used in stmts that follow the RecStmt
+
+ [id] -- Ditto, but these variables are the "recursive" ones, that
+ -- are used before they are bound in the stmts of the RecStmt
+ -- From a type-checking point of view, these ones have to be monomorphic
+
+ --- This field is only valid after typechecking
+ [HsExpr id] -- These expressions correspond
+ -- 1-to-1 with the "recursive" [id], and are the expresions that
+ -- should be returned by the recursion. They may not quite be the
+ -- Ids themselves, because the Id may be *polymorphic*, but
+ -- the returned thing has to be *monomorphic*.
+\end{code}
+
+ExprStmts and ResultStmts are a bit tricky, because what they mean
+depends on the context. Consider the following contexts:
+
+ A do expression of type (m res_ty)
+ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * ExprStmt E any_ty: do { ....; E; ... }
+ E :: m any_ty
+ Translation: E >> ...
+
+ * ResultStmt E: do { ....; E }
+ E :: m res_ty
+ Translation: E
+
+ A list comprehensions of type [elt_ty]
+ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * ExprStmt E Bool: [ .. | .... E ]
+ [ .. | ..., E, ... ]
+ [ .. | .... | ..., E | ... ]
+ E :: Bool
+ Translation: if E then fail else ...
+
+ * ResultStmt E: [ E | ... ]
+ E :: elt_ty
+ Translation: return E
+
+ A guard list, guarding a RHS of type rhs_ty
+ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * ExprStmt E Bool: f x | ..., E, ... = ...rhs...
+ E :: Bool
+ Translation: if E then fail else ...
+
+ * ResultStmt E: f x | ...guards... = E
+ E :: rhs_ty
+ Translation: E
+
+Array comprehensions are handled like list comprehensions -=chak
+
+\begin{code}
+consLetStmt :: HsBinds id -> [Stmt id] -> [Stmt id]
+consLetStmt EmptyBinds stmts = stmts
+consLetStmt binds stmts = LetStmt binds : stmts
+\end{code}
+
+\begin{code}
+instance OutputableBndr id => Outputable (Stmt id) where
+ ppr stmt = pprStmt stmt
+
+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 (RecStmt segment _ _ _) = ptext SLIT("rec") <+> braces (vcat (map ppr segment))
+
+pprDo :: OutputableBndr id => HsStmtContext any -> [Stmt id] -> SDoc
+pprDo DoExpr stmts = hang (ptext SLIT("do")) 2 (vcat (map ppr stmts))
+pprDo MDoExpr stmts = hang (ptext SLIT("mdo")) 3 (vcat (map ppr stmts))
+pprDo ListComp stmts = pprComp brackets stmts
+pprDo PArrComp stmts = pprComp pa_brackets stmts
+
+pprComp :: OutputableBndr id => (SDoc -> SDoc) -> [Stmt id] -> 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
+\end{code}
+
+%************************************************************************
+%* *
+ Template Haskell quotation brackets
+%* *
+%************************************************************************
+
+\begin{code}
+data HsBracket id = ExpBr (HsExpr id)
+ | PatBr (Pat id)
+ | DecBr (HsGroup id)
+ | TypBr (HsType id)
+
+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)
+
+
+thBrackets pp_kind pp_body = char '[' <> pp_kind <> char '|' <+>
+ pp_body <+> ptext SLIT("|]")
+
+data HsReify id = Reify ReifyFlavour id -- Pre typechecking
+ | ReifyOut ReifyFlavour Name -- Post typechecking
+ -- The Name could be the name of
+ -- an Id, TyCon, or Class
+
+data ReifyFlavour = ReifyDecl | ReifyType | ReifyFixity
+
+instance Outputable id => Outputable (HsReify id) where
+ ppr (Reify flavour id) = ppr flavour <+> ppr id
+ ppr (ReifyOut flavour thing) = ppr flavour <+> ppr thing
+
+instance Outputable ReifyFlavour where
+ ppr ReifyDecl = ptext SLIT("reifyDecl")
+ ppr ReifyType = ptext SLIT("reifyType")
+ ppr ReifyFixity = ptext SLIT("reifyFixity")