2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[HsMatches]{Abstract syntax: matches and guarded right-hand-sides}
6 The @Match@, @GRHSs@ and @GRHS@ datatypes.
11 #include "HsVersions.h"
14 import HsExpr ( HsExpr, Stmt(..) )
15 import HsBinds ( HsBinds(..), nullBinds )
16 import HsTypes ( HsTyVar, HsType )
20 import SrcLoc ( SrcLoc )
24 %************************************************************************
26 \subsection{@Match@, @GRHSs@, and @GRHS@ datatypes}
28 %************************************************************************
30 @Match@es are sets of pattern bindings and right hand sides for
31 functions, patterns or case branches. For example, if a function @g@
37 then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.
39 It is always the case that each element of an @[Match]@ list has the
40 same number of @pats@s inside it. This corresponds to saying that
41 a function defined by pattern matching must have the same number of
42 patterns in each equation.
47 [HsTyVar id] -- Tyvars wrt which this match is universally quantified
48 -- emtpy after typechecking
50 (Maybe (HsType id)) -- A type signature for the result of the match
51 -- Nothing after typechecking
55 -- GRHSs are used both for pattern bindings and for Matches
57 = GRHSs [GRHS id pat] -- Guarded RHSs
58 (HsBinds id pat) -- The where clause
59 (Maybe Type) -- Just rhs_ty after type checking
62 = GRHS [Stmt id pat] -- The RHS is the final ExprStmt
63 -- I considered using a RetunStmt, but
64 -- it printed 'wrong' in error messages
67 mkSimpleMatch :: [pat] -> HsExpr id pat -> Maybe Type -> SrcLoc -> Match id pat
68 mkSimpleMatch pats rhs maybe_rhs_ty locn
69 = Match [] pats Nothing (GRHSs (unguardedRHS rhs locn) EmptyBinds maybe_rhs_ty)
71 unguardedRHS :: HsExpr id pat -> SrcLoc -> [GRHS id pat]
72 unguardedRHS rhs loc = [GRHS [ExprStmt rhs loc] loc]
75 @getMatchLoc@ takes a @Match@ and returns the
76 source-location gotten from the GRHS inside.
77 THis is something of a nuisance, but no more.
80 getMatchLoc :: Match id pat -> SrcLoc
81 getMatchLoc (Match _ _ _ (GRHSs (GRHS _ loc : _) _ _)) = loc
84 %************************************************************************
88 %************************************************************************
90 We know the list must have at least one @Match@ in it.
92 pprMatches :: (Outputable id, Outputable pat)
93 => (Bool, SDoc) -> [Match id pat] -> SDoc
94 pprMatches print_info matches = vcat (map (pprMatch print_info) matches)
97 pprMatch :: (Outputable id, Outputable pat)
98 => (Bool, SDoc) -> Match id pat -> SDoc
99 pprMatch print_info@(is_case, name) (Match _ pats maybe_ty grhss)
100 = maybe_name <+> sep [sep (map ppr pats),
102 nest 2 (pprGRHSs is_case grhss)]
104 maybe_name | is_case = empty
106 ppr_maybe_ty = case maybe_ty of
107 Just ty -> dcolon <+> ppr ty
111 pprGRHSs :: (Outputable id, Outputable pat)
112 => Bool -> GRHSs id pat -> SDoc
113 pprGRHSs is_case (GRHSs grhss binds maybe_ty)
114 = vcat (map (pprGRHS is_case) grhss)
116 (if nullBinds binds then empty
117 else text "where" $$ nest 4 (pprDeeper (ppr binds)))
120 pprGRHS :: (Outputable id, Outputable pat)
121 => Bool -> GRHS id pat -> SDoc
123 pprGRHS is_case (GRHS [ExprStmt expr _] locn)
124 = text (if is_case then "->" else "=") <+> pprDeeper (ppr expr)
126 pprGRHS is_case (GRHS guarded locn)
127 = sep [char '|' <+> interpp'SP guards,
128 text (if is_case then "->" else "=") <+> pprDeeper (ppr expr)
131 ExprStmt expr _ = last guarded -- Last stmt should be a ExprStmt for guards
132 guards = init guarded