+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
+-- gaw 2004
+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
+-- gaw 2004
+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 [L _ (ResultStmt expr)])
+ = pp_rhs ctxt expr
+
+pprGRHS ctxt (GRHS guarded)
+ = sep [char '|' <+> interpp'SP guards, pp_rhs ctxt expr]
+ where
+ ResultStmt expr = unLoc (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}
+type LStmt id = Located (Stmt id)
+
+data Stmt id
+ = BindStmt (LPat id) (LHsExpr id)
+ | LetStmt [HsBindGroup id]
+ | ResultStmt (LHsExpr id) -- See notes that follow
+ | ExprStmt (LHsExpr id) PostTcType -- See notes that follow
+ -- The type is the *element type* of the expression
+
+ -- 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
+
+ --- This field is only valid after typechecking
+ [LHsExpr 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
+
+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 (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 -> [LStmt 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) -> [LStmt id] -> SDoc
+pprComp brack stmts
+ = brack $
+ hang (ppr expr <+> char '|')
+ 4 (interpp'SP quals)
+ where
+ ResultStmt expr = unLoc (last stmts) -- Last stmt should
+ quals = init stmts -- be an ResultStmt
+\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("|]")