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
16 import HsExpr ( HsExpr, Stmt )
17 import HsBinds ( HsBinds, nullBinds )
20 import Outputable ( ifPprShowAll, PprStyle, interpp'SP )
21 import PprType ( GenType{-instance Outputable-} )
23 import SrcLoc ( SrcLoc{-instances-} )
25 import Outputable ( Outputable(..) )
26 #if __GLASGOW_HASKELL__ >= 202
32 %************************************************************************
34 \subsection{@Match@, @GRHSsAndBinds@, and @GRHS@ datatypes}
36 %************************************************************************
38 @Match@es are sets of pattern bindings and right hand sides for
39 functions, patterns or case branches. For example, if a function @g@
45 then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.
47 It is always the case that each element of an @[Match]@ list has the
48 same number of @PatMatch@s inside it. This corresponds to saying that
49 a function defined by pattern matching must have the same number of
50 patterns in each equation.
53 data Match tyvar uvar id pat
55 (Match tyvar uvar id pat)
56 | GRHSMatch (GRHSsAndBinds tyvar uvar id pat)
58 | SimpleMatch (HsExpr tyvar uvar id pat) -- Used in translations
61 Sets of guarded right hand sides (GRHSs). In:
66 a guarded right hand side is either
67 @(x==True = y)@, or @(otherwise = y*2)@.
69 For each match, there may be several guarded right hand
70 sides, as the definition of @f@ shows.
73 data GRHSsAndBinds tyvar uvar id pat
74 = GRHSsAndBindsIn [GRHS tyvar uvar id pat] -- at least one GRHS
75 (HsBinds tyvar uvar id pat)
77 | GRHSsAndBindsOut [GRHS tyvar uvar id pat] -- at least one GRHS
78 (HsBinds tyvar uvar id pat)
81 data GRHS tyvar uvar id pat
82 = GRHS [Stmt tyvar uvar id pat] -- guard(ed)...
83 (HsExpr tyvar uvar id pat) -- ... right-hand side
86 | OtherwiseGRHS (HsExpr tyvar uvar id pat) -- guard-free
90 %************************************************************************
94 %************************************************************************
96 We know the list must have at least one @Match@ in it.
98 pprMatches :: (NamedThing id, Outputable id, Outputable pat,
99 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
100 PprStyle -> (Bool, Doc) -> [Match tyvar uvar id pat] -> Doc
102 pprMatches sty print_info@(is_case, name) [match]
104 pprMatch sty is_case match
106 name <+> (pprMatch sty is_case match)
108 pprMatches sty print_info (match1 : rest)
109 = ($$) (pprMatches sty print_info [match1])
110 (pprMatches sty print_info rest)
112 ---------------------------------------------
113 pprMatch :: (NamedThing id, Outputable id, Outputable pat,
114 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
115 PprStyle -> Bool -> Match tyvar uvar id pat -> Doc
117 pprMatch sty is_case first_match
118 = sep [(sep (map (ppr sty) row_of_pats)),
121 (row_of_pats, grhss_etc_stuff) = ppr_match sty is_case first_match
123 ppr_match sty is_case (PatMatch pat match)
124 = (pat:pats, grhss_stuff)
126 (pats, grhss_stuff) = ppr_match sty is_case match
128 ppr_match sty is_case (GRHSMatch grhss_n_binds)
129 = ([], pprGRHSsAndBinds sty is_case grhss_n_binds)
131 ppr_match sty is_case (SimpleMatch expr)
132 = ([], text (if is_case then "->" else "=") <+> ppr sty expr)
134 ----------------------------------------------------------
136 pprGRHSsAndBinds :: (NamedThing id, Outputable id, Outputable pat,
137 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
138 PprStyle -> Bool -> GRHSsAndBinds tyvar uvar id pat -> Doc
140 pprGRHSsAndBinds sty is_case (GRHSsAndBindsIn grhss binds)
141 = ($$) (vcat (map (pprGRHS sty is_case) grhss))
142 (if (nullBinds binds)
144 else vcat [ text "where", nest 4 (ppr sty binds) ])
146 pprGRHSsAndBinds sty is_case (GRHSsAndBindsOut grhss binds ty)
147 = ($$) (vcat (map (pprGRHS sty is_case) grhss))
148 (if (nullBinds binds)
150 else vcat [ ifPprShowAll sty
151 (hsep [text "{- ty:", ppr sty ty, text "-}"]),
152 text "where", nest 4 (ppr sty binds) ])
154 ---------------------------------------------
155 pprGRHS :: (NamedThing id, Outputable id, Outputable pat,
156 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
157 => PprStyle -> Bool -> GRHS tyvar uvar id pat -> Doc
159 pprGRHS sty is_case (GRHS [] expr locn)
160 = text (if is_case then "->" else "=") <+> ppr sty expr
162 pprGRHS sty is_case (GRHS guard expr locn)
163 = sep [char '|' <+> interpp'SP sty guard,
164 text (if is_case then "->" else "=") <+> ppr sty expr
167 pprGRHS sty is_case (OtherwiseGRHS expr locn)
168 = text (if is_case then "->" else "=") <+> ppr sty expr