2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[PatSyntax]{Abstract Haskell syntax---patterns}
7 #include "HsVersions.h"
13 irrefutablePat, irrefutablePats,
15 patsAreAllCons, isConPat,
16 patsAreAllLits, isLitPat,
23 import HsBasic ( HsLit, Fixity )
24 IMPORT_DELOOPER(HsLoop) ( HsExpr )
27 import Id ( dataConTyCon, GenId )
28 import Maybes ( maybeToBool )
29 import Name ( pprSym, pprNonSym )
30 import Outputable ( interppSP, interpp'SP, ifPprShowAll )
31 import PprStyle ( PprStyle(..) )
33 import TyCon ( maybeTyConSingleCon )
34 import PprType ( GenType )
37 Patterns come in distinct before- and after-typechecking flavo(u)rs.
40 = WildPatIn -- wild card
41 | VarPatIn name -- variable
42 | LitPatIn HsLit -- literal
43 | LazyPatIn (InPat name) -- lazy pattern
44 | AsPatIn name -- as pattern
46 | ConPatIn name -- constructed type
48 | ConOpPatIn (InPat name)
50 Fixity -- c.f. OpApp in HsExpr
53 | NPlusKPatIn name -- n+k pattern
56 -- We preserve prefix negation and parenthesis for the precedence parser.
58 | NegPatIn (InPat name) -- negated pattern
59 | ParPatIn (InPat name) -- parenthesised pattern
61 | ListPatIn [InPat name] -- syntactic list
62 -- must have >= 1 elements
63 | TuplePatIn [InPat name] -- tuple
65 | RecPatIn name -- record
66 [(name, InPat name, Bool)] -- True <=> source used punning
68 data OutPat tyvar uvar id
69 = WildPat (GenType tyvar uvar) -- wild card
71 | VarPat id -- variable (type is in the Id)
73 | LazyPat (OutPat tyvar uvar id) -- lazy pattern
75 | AsPat id -- as pattern
76 (OutPat tyvar uvar id)
78 | ConPat Id -- Constructor is always an Id
79 (GenType tyvar uvar) -- the type of the pattern
80 [OutPat tyvar uvar id]
82 | ConOpPat (OutPat tyvar uvar id) -- just a special case...
84 (OutPat tyvar uvar id)
86 | ListPat -- syntactic list
87 (GenType tyvar uvar) -- the type of the elements
88 [OutPat tyvar uvar id]
90 | TuplePat [OutPat tyvar uvar id] -- tuple
91 -- UnitPat is TuplePat []
93 | RecPat Id -- record constructor
94 (GenType tyvar uvar) -- the type of the pattern
95 [(Id, OutPat tyvar uvar id, Bool)] -- True <=> source used punning
97 | LitPat -- Used for *non-overloaded* literal patterns:
98 -- Int#, Char#, Int, Char, String, etc.
100 (GenType tyvar uvar) -- type of pattern
102 | NPat -- Used for *overloaded* literal patterns
103 HsLit -- the literal is retained so that
104 -- the desugarer can readily identify
105 -- equations with identical literal-patterns
106 (GenType tyvar uvar) -- type of pattern, t
107 (HsExpr tyvar uvar id (OutPat tyvar uvar id))
108 -- of type t -> Bool; detects match
111 HsLit -- Same reason as for LitPat
112 -- (This could be an Integer, but then
113 -- it's harder to partitionEqnsByLit
114 -- in the desugarer.)
115 (GenType tyvar uvar) -- Type of pattern, t
116 (HsExpr tyvar uvar id (OutPat tyvar uvar id)) -- Of type t -> Bool; detects match
117 (HsExpr tyvar uvar id (OutPat tyvar uvar id)) -- Of type t -> t; subtracts k
119 | DictPat -- Used when destructing Dictionaries with an explicit case
120 [id] -- superclass dicts
125 instance (Outputable name, NamedThing name) => Outputable (InPat name) where
128 pprInPat :: (Outputable name, NamedThing name) => PprStyle -> InPat name -> Pretty
130 pprInPat sty (WildPatIn) = ppChar '_'
131 pprInPat sty (VarPatIn var) = ppr sty var
132 pprInPat sty (LitPatIn s) = ppr sty s
133 pprInPat sty (LazyPatIn pat) = ppBeside (ppChar '~') (ppr sty pat)
134 pprInPat sty (AsPatIn name pat)
135 = ppBesides [ppLparen, ppr sty name, ppChar '@', ppr sty pat, ppRparen]
137 pprInPat sty (ConPatIn c pats)
141 ppCat [ppr sty c, interppSP sty pats] -- ParPats put in the parens
143 pprInPat sty (ConOpPatIn pat1 op fixity pat2)
144 = ppCat [ppr sty pat1, ppr sty op, ppr sty pat2] -- ParPats put in parens
146 -- ToDo: use pprSym to print op (but this involves fiddling various
147 -- contexts & I'm lazy...); *PatIns are *rarely* printed anyway... (WDP)
149 pprInPat sty (NegPatIn pat)
151 pp_pat = pprInPat sty pat
153 ppBeside (ppChar '-') (
159 pprInPat sty (ParPatIn pat)
160 = ppParens (pprInPat sty pat)
162 pprInPat sty (ListPatIn pats)
163 = ppBesides [ppLbrack, interpp'SP sty pats, ppRbrack]
164 pprInPat sty (TuplePatIn pats)
165 = ppParens (interpp'SP sty pats)
166 pprInPat sty (NPlusKPatIn n k)
167 = ppBesides [ppLparen, ppr sty n, ppChar '+', ppr sty k, ppRparen]
169 pprInPat sty (RecPatIn con rpats)
170 = ppCat [ppr sty con, ppCurlies (ppIntersperse pp'SP (map (pp_rpat sty) rpats))]
172 pp_rpat PprForUser (v, _, True) = ppr PprForUser v
173 pp_rpat sty (v, p, _) = ppCat [ppr sty v, ppChar '=', ppr sty p]
177 instance (Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar, Outputable id)
178 => Outputable (OutPat tyvar uvar id) where
183 pprOutPat sty (WildPat ty) = ppChar '_'
184 pprOutPat sty (VarPat var) = ppr sty var
185 pprOutPat sty (LazyPat pat) = ppBesides [ppChar '~', ppr sty pat]
186 pprOutPat sty (AsPat name pat)
187 = ppBesides [ppLparen, ppr sty name, ppChar '@', ppr sty pat, ppRparen]
189 pprOutPat sty (ConPat name ty [])
190 = ppBeside (ppr sty name)
191 (ifPprShowAll sty (pprConPatTy sty ty))
193 pprOutPat sty (ConPat name ty pats)
194 = ppBesides [ppLparen, ppr sty name, ppSP,
195 interppSP sty pats, ppRparen,
196 ifPprShowAll sty (pprConPatTy sty ty) ]
198 pprOutPat sty (ConOpPat pat1 op pat2 ty)
199 = ppBesides [ppLparen, ppr sty pat1, ppSP, pprSym sty op, ppSP, ppr sty pat2, ppRparen]
201 pprOutPat sty (ListPat ty pats)
202 = ppBesides [ppLbrack, interpp'SP sty pats, ppRbrack]
203 pprOutPat sty (TuplePat pats)
204 = ppParens (interpp'SP sty pats)
206 pprOutPat sty (RecPat con ty rpats)
207 = ppBesides [ppr sty con, ppCurlies (ppIntersperse pp'SP (map (pp_rpat sty) rpats))]
209 pp_rpat PprForUser (v, _, True) = ppr PprForUser v
210 pp_rpat sty (v, p, _) = ppCat [ppr sty v, ppChar '=', ppr sty p]
212 pprOutPat sty (LitPat l ty) = ppr sty l -- ToDo: print more
213 pprOutPat sty (NPat l ty e) = ppr sty l -- ToDo: print more
214 pprOutPat sty (NPlusKPat n k ty e1 e2) -- ToDo: print more
215 = ppBesides [ppLparen, ppr sty n, ppChar '+', ppr sty k, ppRparen]
217 pprOutPat sty (DictPat dicts methods)
218 = ppSep [ppBesides [ppLparen, ppPStr SLIT("{-dict-}")],
219 ppBracket (interpp'SP sty dicts),
220 ppBesides [ppBracket (interpp'SP sty methods), ppRparen]]
223 = ppParens (ppr sty ty)
226 %************************************************************************
228 %* predicates for checking things about pattern-lists in EquationInfo *
230 %************************************************************************
231 \subsection[Pat-list-predicates]{Look for interesting things in patterns}
233 Unlike in the Wadler chapter, where patterns are either ``variables''
234 or ``constructors,'' here we distinguish between:
237 Patterns that cannot fail to match: variables, wildcards, and lazy
240 These are the irrefutable patterns; the two other categories
241 are refutable patterns.
244 A non-literal constructor pattern (see next category).
246 \item[literal patterns:]
247 At least the numeric ones may be overloaded.
250 A pattern is in {\em exactly one} of the above three categories; `as'
251 patterns are treated specially, of course.
253 The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
255 irrefutablePats :: [OutPat a b c] -> Bool
256 irrefutablePats pat_list = all irrefutablePat pat_list
258 irrefutablePat (AsPat _ pat) = irrefutablePat pat
259 irrefutablePat (WildPat _) = True
260 irrefutablePat (VarPat _) = True
261 irrefutablePat (LazyPat _) = True
262 irrefutablePat (DictPat ds ms) = (length ds + length ms) <= 1
263 irrefutablePat other = False
265 failureFreePat :: OutPat a b c -> Bool
267 failureFreePat (WildPat _) = True
268 failureFreePat (VarPat _) = True
269 failureFreePat (LazyPat _) = True
270 failureFreePat (AsPat _ pat) = failureFreePat pat
271 failureFreePat (ConPat con tys pats) = only_con con && all failureFreePat pats
272 failureFreePat (ConOpPat pat1 con pat2 _) = only_con con && failureFreePat pat1 && failureFreePat pat1
273 failureFreePat (RecPat con _ fields) = only_con con && and [ failureFreePat pat | (_,pat,_) <- fields ]
274 failureFreePat (ListPat _ _) = False
275 failureFreePat (TuplePat pats) = all failureFreePat pats
276 failureFreePat (DictPat _ _) = True
277 failureFreePat other_pat = False -- Literals, NPat
279 only_con con = maybeToBool (maybeTyConSingleCon (dataConTyCon con))
283 patsAreAllCons :: [OutPat a b c] -> Bool
284 patsAreAllCons pat_list = all isConPat pat_list
286 isConPat (AsPat _ pat) = isConPat pat
287 isConPat (ConPat _ _ _) = True
288 isConPat (ConOpPat _ _ _ _) = True
289 isConPat (ListPat _ _) = True
290 isConPat (TuplePat _) = True
291 isConPat (RecPat _ _ _) = True
292 isConPat (DictPat ds ms) = (length ds + length ms) > 1
293 isConPat other = False
295 patsAreAllLits :: [OutPat a b c] -> Bool
296 patsAreAllLits pat_list = all isLitPat pat_list
298 isLitPat (AsPat _ pat) = isLitPat pat
299 isLitPat (LitPat _ _) = True
300 isLitPat (NPat _ _ _) = True
301 isLitPat (NPlusKPat _ _ _ _ _) = True
302 isLitPat other = False
305 This function @collectPatBinders@ works with the ``collectBinders''
306 functions for @HsBinds@, etc. The order in which the binders are
307 collected is important; see @HsBinds.lhs@.
309 collectPatBinders :: InPat a -> [a]
311 collectPatBinders WildPatIn = []
312 collectPatBinders (VarPatIn var) = [var]
313 collectPatBinders (LitPatIn _) = []
314 collectPatBinders (LazyPatIn pat) = collectPatBinders pat
315 collectPatBinders (AsPatIn a pat) = a : collectPatBinders pat
316 collectPatBinders (NPlusKPatIn n _) = [n]
317 collectPatBinders (ConPatIn c pats) = concat (map collectPatBinders pats)
318 collectPatBinders (ConOpPatIn p1 c f p2) = collectPatBinders p1 ++ collectPatBinders p2
319 collectPatBinders (NegPatIn pat) = collectPatBinders pat
320 collectPatBinders (ParPatIn pat) = collectPatBinders pat
321 collectPatBinders (ListPatIn pats) = concat (map collectPatBinders pats)
322 collectPatBinders (TuplePatIn pats) = concat (map collectPatBinders pats)
323 collectPatBinders (RecPatIn c fields) = concat (map (\ (f,pat,_) -> collectPatBinders pat) fields)