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 HsLoop ( HsExpr, nullBinds, HsBinds )
16 import Outputable ( ifPprShowAll )
17 import PprType ( GenType{-instance Outputable-} )
19 import SrcLoc ( SrcLoc{-instances-} )
23 %************************************************************************
25 \subsection{@Match@, @GRHSsAndBinds@, and @GRHS@ datatypes}
27 %************************************************************************
29 @Match@es are sets of pattern bindings and right hand sides for
30 functions, patterns or case branches. For example, if a function @g@
36 then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.
38 It is always the case that each element of an @[Match]@ list has the
39 same number of @PatMatch@s inside it. This corresponds to saying that
40 a function defined by pattern matching must have the same number of
41 patterns in each equation.
44 data Match tyvar uvar id pat
46 (Match tyvar uvar id pat)
47 | GRHSMatch (GRHSsAndBinds tyvar uvar id pat)
49 | SimpleMatch (HsExpr tyvar uvar id pat) -- Used in translations
52 Sets of guarded right hand sides (GRHSs). In:
57 a guarded right hand side is either
58 @(x==True = y)@, or @(otherwise = y*2)@.
60 For each match, there may be several guarded right hand
61 sides, as the definition of @f@ shows.
64 data GRHSsAndBinds tyvar uvar id pat
65 = GRHSsAndBindsIn [GRHS tyvar uvar id pat] -- at least one GRHS
66 (HsBinds tyvar uvar id pat)
68 | GRHSsAndBindsOut [GRHS tyvar uvar id pat] -- at least one GRHS
69 (HsBinds tyvar uvar id pat)
72 data GRHS tyvar uvar id pat
73 = GRHS (HsExpr tyvar uvar id pat) -- guard(ed)...
74 (HsExpr tyvar uvar id pat) -- ... right-hand side
77 | OtherwiseGRHS (HsExpr tyvar uvar id pat) -- guard-free
81 %************************************************************************
85 %************************************************************************
87 We know the list must have at least one @Match@ in it.
89 pprMatches :: (NamedThing id, Outputable id, Outputable pat,
90 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
91 PprStyle -> (Bool, Pretty) -> [Match tyvar uvar id pat] -> Pretty
93 pprMatches sty print_info@(is_case, name) [match]
95 pprMatch sty is_case match
97 ppHang name 4 (pprMatch sty is_case match)
99 pprMatches sty print_info (match1 : rest)
100 = ppAbove (pprMatches sty print_info [match1])
101 (pprMatches sty print_info rest)
103 ---------------------------------------------
104 pprMatch :: (NamedThing id, Outputable id, Outputable pat,
105 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
106 PprStyle -> Bool -> Match tyvar uvar id pat -> Pretty
108 pprMatch sty is_case first_match
109 = ppHang (ppSep (map (ppr sty) row_of_pats))
112 (row_of_pats, grhss_etc_stuff) = ppr_match sty is_case first_match
114 ppr_match sty is_case (PatMatch pat match)
115 = (pat:pats, grhss_stuff)
117 (pats, grhss_stuff) = ppr_match sty is_case match
119 ppr_match sty is_case (GRHSMatch grhss_n_binds)
120 = ([], pprGRHSsAndBinds sty is_case grhss_n_binds)
122 ppr_match sty is_case (SimpleMatch expr)
125 ----------------------------------------------------------
127 pprGRHSsAndBinds sty is_case (GRHSsAndBindsIn grhss binds)
128 = ppAbove (ppAboves (map (pprGRHS sty is_case) grhss))
129 (if (nullBinds binds)
131 else ppAboves [ ppStr "where", ppNest 4 (ppr sty binds) ])
133 pprGRHSsAndBinds sty is_case (GRHSsAndBindsOut grhss binds ty)
134 = ppAbove (ppAboves (map (pprGRHS sty is_case) grhss))
135 (if (nullBinds binds)
137 else ppAboves [ ifPprShowAll sty
138 (ppCat [ppStr "{- ty:", ppr sty ty, ppStr "-}"]),
139 ppStr "where", ppNest 4 (ppr sty binds) ])
141 ---------------------------------------------
142 pprGRHS :: (NamedThing id, Outputable id, Outputable pat,
143 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
144 => PprStyle -> Bool -> GRHS tyvar uvar id pat -> Pretty
146 pprGRHS sty is_case (GRHS guard expr locn)
147 = ppHang (ppCat [ppChar '|', ppr sty guard, ppStr (if is_case then "->" else "=")])
150 pprGRHS sty is_case (OtherwiseGRHS expr locn)
151 = ppHang (ppStr (if is_case then "->" else "="))