2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
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 PprType ( GenType{-instance Outputable-} )
19 import SrcLoc ( SrcLoc{-instances-} )
22 import Name ( NamedThing )
25 %************************************************************************
27 \subsection{@Match@, @GRHSsAndBinds@, and @GRHS@ datatypes}
29 %************************************************************************
31 @Match@es are sets of pattern bindings and right hand sides for
32 functions, patterns or case branches. For example, if a function @g@
38 then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.
40 It is always the case that each element of an @[Match]@ list has the
41 same number of @PatMatch@s inside it. This corresponds to saying that
42 a function defined by pattern matching must have the same number of
43 patterns in each equation.
46 data Match flexi id pat
49 | GRHSMatch (GRHSsAndBinds flexi id pat)
51 | SimpleMatch (HsExpr flexi id pat) -- Used in translations
54 Sets of guarded right hand sides (GRHSs). In:
59 a guarded right hand side is either
60 @(x==True = y)@, or @(otherwise = y*2)@.
62 For each match, there may be several guarded right hand
63 sides, as the definition of @f@ shows.
66 data GRHSsAndBinds flexi id pat
67 = GRHSsAndBindsIn [GRHS flexi id pat] -- at least one GRHS
68 (HsBinds flexi id pat)
70 | GRHSsAndBindsOut [GRHS flexi id pat] -- at least one GRHS
71 (HsBinds flexi id pat)
74 data GRHS flexi id pat
75 = GRHS [Stmt flexi id pat] -- guard(ed)...
76 (HsExpr flexi id pat) -- ... right-hand side
79 unguardedRHS :: (HsExpr flexi id pat) -> SrcLoc -> [GRHS flexi id pat]
80 unguardedRHS rhs loc = [GRHS [] rhs 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 (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 (ppr binds) ])
152 ---------------------------------------------
153 pprGRHS :: (NamedThing id, Outputable id, Outputable pat)
154 => Bool -> GRHS flexi id pat -> SDoc
156 pprGRHS is_case (GRHS [] expr locn)
157 = text (if is_case then "->" else "=") <+> ppr expr
159 pprGRHS is_case (GRHS guard expr locn)
160 = sep [char '|' <+> interpp'SP guard,
161 text (if is_case then "->" else "=") <+> ppr expr