2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[HsMatches]{Abstract syntax: matches and guarded right-hand-sides}
6 The @Match@, @GRHSsAndBinds@ and @GRHS@ datatypes.
11 #include "HsVersions.h"
14 import HsExpr ( HsExpr, Stmt(..) )
15 import HsBinds ( HsBinds, nullBinds )
18 import Type ( GenType )
19 import SrcLoc ( SrcLoc )
21 import Name ( NamedThing )
24 %************************************************************************
26 \subsection{@Match@, @GRHSsAndBinds@, 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 @PatMatch@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.
45 data Match flexi id pat
48 | GRHSMatch (GRHSsAndBinds flexi id pat)
50 | SimpleMatch (HsExpr flexi id pat) -- Used in translations
53 Sets of guarded right hand sides (GRHSs). In:
58 a guarded right hand side is either
59 @(x==True = y)@, or @(otherwise = y*2)@.
61 For each match, there may be several guarded right hand
62 sides, as the definition of @f@ shows.
65 data GRHSsAndBinds flexi id pat
66 = GRHSsAndBindsIn [GRHS flexi id pat] -- at least one GRHS
67 (HsBinds flexi id pat)
69 | GRHSsAndBindsOut [GRHS flexi id pat] -- at least one GRHS
70 (HsBinds flexi id pat)
73 data GRHS flexi id pat
74 = GRHS [Stmt flexi id pat] -- The RHS is the final ExprStmt
75 -- I considered using a RetunStmt, but
76 -- it printed 'wrong' in error messages
79 unguardedRHS :: (HsExpr flexi id pat) -> SrcLoc -> [GRHS flexi id pat]
80 unguardedRHS rhs loc = [GRHS [ExprStmt rhs loc] loc]
83 @getMatchLoc@ takes a @Match@ and returns the
84 source-location gotten from the GRHS inside.
85 THis is something of a nuisance, but no more.
88 getMatchLoc :: Match flexi id pat -> SrcLoc
89 getMatchLoc (PatMatch _ m) = getMatchLoc m
90 getMatchLoc (GRHSMatch (GRHSsAndBindsIn (GRHS _ loc : _) _)) = loc
93 %************************************************************************
97 %************************************************************************
99 We know the list must have at least one @Match@ in it.
101 pprMatches :: (NamedThing id, Outputable id, Outputable pat)
102 => (Bool, SDoc) -> [Match flexi id pat] -> SDoc
104 pprMatches print_info@(is_case, name) [match]
106 pprMatch is_case match
108 name <+> (pprMatch is_case match)
110 pprMatches print_info (match1 : rest)
111 = ($$) (pprMatches print_info [match1])
112 (pprMatches print_info rest)
114 ---------------------------------------------
115 pprMatch :: (NamedThing id, Outputable id, Outputable pat)
116 => Bool -> Match flexi id pat -> SDoc
118 pprMatch is_case first_match
119 = sep [(sep (map (ppr) row_of_pats)),
122 (row_of_pats, grhss_etc_stuff) = ppr_match is_case first_match
124 ppr_match is_case (PatMatch pat match)
125 = (pat:pats, grhss_stuff)
127 (pats, grhss_stuff) = ppr_match is_case match
129 ppr_match is_case (GRHSMatch grhss_n_binds)
130 = ([], pprGRHSsAndBinds is_case grhss_n_binds)
132 ppr_match is_case (SimpleMatch expr)
133 = ([], text (if is_case then "->" else "=") <+> ppr expr)
135 ----------------------------------------------------------
137 pprGRHSsAndBinds :: (NamedThing id, Outputable id, Outputable pat)
138 => Bool -> GRHSsAndBinds flexi id pat -> SDoc
140 pprGRHSsAndBinds is_case (GRHSsAndBindsIn grhss binds)
141 = ($$) (vcat (map (pprGRHS is_case) grhss))
142 (if (nullBinds binds)
144 else vcat [ text "where", nest 4 (pprDeeper (ppr binds)) ])
146 pprGRHSsAndBinds is_case (GRHSsAndBindsOut grhss binds ty)
147 = ($$) (vcat (map (pprGRHS is_case) grhss))
148 (if (nullBinds binds)
150 else vcat [text "where", nest 4 (pprDeeper (ppr binds)) ])
152 ---------------------------------------------
153 pprGRHS :: (NamedThing id, Outputable id, Outputable pat)
154 => Bool -> GRHS flexi id pat -> SDoc
156 pprGRHS is_case (GRHS [ExprStmt expr _] locn)
157 = text (if is_case then "->" else "=") <+> pprDeeper (ppr expr)
159 pprGRHS is_case (GRHS guarded locn)
160 = sep [char '|' <+> interpp'SP guards,
161 text (if is_case then "->" else "=") <+> pprDeeper (ppr expr)
164 ExprStmt expr _ = last guarded -- Last stmt should be a ExprStmt for guards
165 guards = init guarded