-data StmtCtxt -- Context of a Stmt
- = DoStmt -- Do Statment
- | ListComp -- List comprehension
- | CaseAlt -- Guard on a case alternative
- | PatBindRhs -- Guard on a pattern binding
- | FunRhs Name -- Guard on a function defn for f
- | LambdaBody -- Body of a lambda abstraction
-
-pprDo DoStmt stmts
- = hang (ptext SLIT("do")) 2 (vcat (map ppr stmts))
-pprDo ListComp stmts
- = brackets $
- hang (pprExpr expr <+> char '|')
- 4 (interpp'SP quals)
+data Match id pat
+ = Match
+ [id] -- Tyvars wrt which this match is universally quantified
+ -- empty after typechecking
+ [pat] -- The patterns
+ (Maybe (HsType id)) -- A type signature for the result of the match
+ -- Nothing after typechecking
+
+ (GRHSs id pat)
+
+-- GRHSs are used both for pattern bindings and for Matches
+data GRHSs id pat
+ = GRHSs [GRHS id pat] -- Guarded RHSs
+ (HsBinds id pat) -- The where clause
+ (Maybe Type) -- Just rhs_ty after type checking
+
+data GRHS id pat
+ = GRHS [Stmt id pat] -- The RHS is the final ExprStmt
+ -- I considered using a RetunStmt, but
+ -- it printed 'wrong' in error messages
+ SrcLoc
+
+mkSimpleMatch :: [pat] -> HsExpr id pat -> Maybe Type -> SrcLoc -> Match id pat
+mkSimpleMatch pats rhs maybe_rhs_ty locn
+ = Match [] pats Nothing (GRHSs (unguardedRHS rhs locn) EmptyBinds maybe_rhs_ty)
+
+unguardedRHS :: HsExpr id pat -> SrcLoc -> [GRHS id pat]
+unguardedRHS rhs loc = [GRHS [ExprStmt rhs loc] loc]
+\end{code}
+
+@getMatchLoc@ takes a @Match@ and returns the
+source-location gotten from the GRHS inside.
+THis is something of a nuisance, but no more.
+
+\begin{code}
+getMatchLoc :: Match id pat -> SrcLoc
+getMatchLoc (Match _ _ _ (GRHSs (GRHS _ loc : _) _ _)) = loc
+\end{code}
+
+We know the list must have at least one @Match@ in it.
+
+\begin{code}
+pprMatches :: (Outputable id, Outputable pat)
+ => (Bool, SDoc) -> [Match id pat] -> SDoc
+pprMatches print_info matches = vcat (map (pprMatch print_info) matches)
+
+
+pprMatch :: (Outputable id, Outputable pat)
+ => (Bool, SDoc) -> Match id pat -> SDoc
+pprMatch print_info@(is_case, name) (Match _ pats maybe_ty grhss)
+ = maybe_name <+> sep [sep (map ppr pats),
+ ppr_maybe_ty,
+ nest 2 (pprGRHSs is_case grhss)]