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.
9 #include "HsVersions.h"
11 module HsMatches where
15 IMPORT_DELOOPER(HsLoop) ( HsExpr, Stmt, nullBinds, HsBinds )
16 import Outputable --( ifPprShowAll )
17 import PprType ( GenType{-instance Outputable-} )
19 import SrcLoc ( SrcLoc{-instances-} )
21 #if __GLASGOW_HASKELL__ >= 202
28 %************************************************************************
30 \subsection{@Match@, @GRHSsAndBinds@, and @GRHS@ datatypes}
32 %************************************************************************
34 @Match@es are sets of pattern bindings and right hand sides for
35 functions, patterns or case branches. For example, if a function @g@
41 then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.
43 It is always the case that each element of an @[Match]@ list has the
44 same number of @PatMatch@s inside it. This corresponds to saying that
45 a function defined by pattern matching must have the same number of
46 patterns in each equation.
49 data Match tyvar uvar id pat
51 (Match tyvar uvar id pat)
52 | GRHSMatch (GRHSsAndBinds tyvar uvar id pat)
54 | SimpleMatch (HsExpr tyvar uvar id pat) -- Used in translations
57 Sets of guarded right hand sides (GRHSs). In:
62 a guarded right hand side is either
63 @(x==True = y)@, or @(otherwise = y*2)@.
65 For each match, there may be several guarded right hand
66 sides, as the definition of @f@ shows.
69 data GRHSsAndBinds tyvar uvar id pat
70 = GRHSsAndBindsIn [GRHS tyvar uvar id pat] -- at least one GRHS
71 (HsBinds tyvar uvar id pat)
73 | GRHSsAndBindsOut [GRHS tyvar uvar id pat] -- at least one GRHS
74 (HsBinds tyvar uvar id pat)
77 data GRHS tyvar uvar id pat
78 = GRHS [Stmt tyvar uvar id pat] -- guard(ed)...
79 (HsExpr tyvar uvar id pat) -- ... right-hand side
82 | OtherwiseGRHS (HsExpr tyvar uvar id pat) -- guard-free
86 %************************************************************************
90 %************************************************************************
92 We know the list must have at least one @Match@ in it.
94 pprMatches :: (NamedThing id, Outputable id, Outputable pat,
95 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
96 PprStyle -> (Bool, Doc) -> [Match tyvar uvar id pat] -> Doc
98 pprMatches sty print_info@(is_case, name) [match]
100 pprMatch sty is_case match
102 hang name 4 (pprMatch sty is_case match)
104 pprMatches sty print_info (match1 : rest)
105 = ($$) (pprMatches sty print_info [match1])
106 (pprMatches sty print_info rest)
108 ---------------------------------------------
109 pprMatch :: (NamedThing id, Outputable id, Outputable pat,
110 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
111 PprStyle -> Bool -> Match tyvar uvar id pat -> Doc
113 pprMatch sty is_case first_match
114 = hang (sep (map (ppr sty) row_of_pats))
117 (row_of_pats, grhss_etc_stuff) = ppr_match sty is_case first_match
119 ppr_match sty is_case (PatMatch pat match)
120 = (pat:pats, grhss_stuff)
122 (pats, grhss_stuff) = ppr_match sty is_case match
124 ppr_match sty is_case (GRHSMatch grhss_n_binds)
125 = ([], pprGRHSsAndBinds sty is_case grhss_n_binds)
127 ppr_match sty is_case (SimpleMatch expr)
128 = ([], hang (text (if is_case then "->" else "="))
131 ----------------------------------------------------------
133 pprGRHSsAndBinds sty is_case (GRHSsAndBindsIn grhss binds)
134 = ($$) (vcat (map (pprGRHS sty is_case) grhss))
135 (if (nullBinds binds)
137 else vcat [ text "where", nest 4 (ppr sty binds) ])
139 pprGRHSsAndBinds sty is_case (GRHSsAndBindsOut grhss binds ty)
140 = ($$) (vcat (map (pprGRHS sty is_case) grhss))
141 (if (nullBinds binds)
143 else vcat [ ifPprShowAll sty
144 (hsep [text "{- ty:", ppr sty ty, text "-}"]),
145 text "where", nest 4 (ppr sty binds) ])
147 ---------------------------------------------
148 pprGRHS :: (NamedThing id, Outputable id, Outputable pat,
149 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
150 => PprStyle -> Bool -> GRHS tyvar uvar id pat -> Doc
152 pprGRHS sty is_case (GRHS [] expr locn)
153 = hang (text (if is_case then "->" else "="))
156 pprGRHS sty is_case (GRHS guard expr locn)
157 = hang (hsep [char '|', ppr sty guard, text (if is_case then "->" else "=")])
160 pprGRHS sty is_case (OtherwiseGRHS expr locn)
161 = hang (text (if is_case then "->" else "="))