+pprMatches :: (OutputableBndr id) => HsMatchContext id -> MatchGroup id -> SDoc
+pprMatches ctxt (MatchGroup matches _) = vcat (map (pprMatch ctxt) (map unLoc matches))
+
+-- Exported to HsBinds, which can't see the defn of HsMatchContext
+pprFunBind :: (OutputableBndr id) => id -> MatchGroup id -> SDoc
+pprFunBind fun matches = pprMatches (FunRhs fun) matches
+
+-- Exported to HsBinds, which can't see the defn of HsMatchContext
+pprPatBind :: (OutputableBndr bndr, OutputableBndr id)
+ => LPat bndr -> 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)
+ = vcat (map (pprGRHS ctxt . unLoc) grhss)
+ $$
+ (if null binds then empty
+ else text "where" $$ nest 4 (pprBinds binds))
+
+pprGRHS :: OutputableBndr id => HsMatchContext id -> GRHS id -> SDoc
+
+pprGRHS ctxt (GRHS [] expr)
+ = pp_rhs ctxt expr
+
+pprGRHS ctxt (GRHS guards expr)
+ = sep [char '|' <+> interpp'SP guards, pp_rhs ctxt expr]
+
+pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Do stmts and list comprehensions}
+%* *
+%************************************************************************
+
+\begin{code}
+type LStmt id = Located (Stmt id)
+
+-- The SyntaxExprs in here are used *only* for do-notation, which
+-- has rebindable syntax. Otherwise they are unused.
+data Stmt id
+ = BindStmt (LPat id)
+ (LHsExpr id)
+ (SyntaxExpr id) -- The (>>=) operator
+ (SyntaxExpr id) -- The fail operator
+ -- The fail operator is noSyntaxExpr
+ -- if the pattern match can't fail
+
+ | ExprStmt (LHsExpr id)
+ (SyntaxExpr id) -- The (>>) operator
+ PostTcType -- Element type of the RHS (used for arrows)
+
+ | LetStmt [HsBindGroup id]
+
+ -- ParStmts only occur in a list comprehension
+ | ParStmt [([LStmt id], [id])] -- After remaing, the ids are the binders
+ -- bound by the stmts and used subsequently
+
+ -- Recursive statement (see Note [RecStmt] below)
+ | RecStmt [LStmt 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
+
+ --- These fields are only valid after typechecking
+ [PostTcExpr] -- 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*.
+ (DictBinds id) -- Method bindings of Ids bound by the RecStmt,
+ -- and used afterwards
+\end{code}
+
+ExprStmts 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 >> ...
+
+ A list comprehensions of type [elt_ty]
+ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ * ExprStmt E Bool: [ .. | .... E ]
+ [ .. | ..., E, ... ]
+ [ .. | .... | ..., E | ... ]
+ E :: Bool
+ Translation: if E then fail else ...
+
+ 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 ...
+
+Array comprehensions are handled like list comprehensions -=chak
+
+Note [RecStmt]
+~~~~~~~~~~~~~~
+Example:
+ HsDo [ BindStmt x ex
+
+ , RecStmt [a::forall a. a -> a, b]
+ [a::Int -> Int, c]
+ [ BindStmt b (return x)
+ , LetStmt a = ea
+ , BindStmt c ec ]
+
+ , return (a b) ]
+
+Here, the RecStmt binds a,b,c; but
+ - Only a,b are used in the stmts *following* the RecStmt,
+ This 'a' is *polymorphic'
+ - Only a,c are used in the stmts *inside* the RecStmt
+ *before* their bindings
+ This 'a' is monomorphic
+
+Nota Bene: the two a's have different types, even though they
+have the same Name.
+
+
+\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 (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("|]")