2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[PatSyntax]{Abstract Haskell syntax---patterns}
7 #include "HsVersions.h"
13 unfailablePats, unfailablePat,
14 patsAreAllCons, isConPat,
15 patsAreAllLits, isLitPat,
23 import HsLit ( HsLit )
24 import HsLoop ( HsExpr )
27 import Id ( GenId, dataConSig )
28 import Maybes ( maybeToBool )
30 import PprStyle ( PprStyle(..) )
32 import TyCon ( maybeTyConSingleCon )
33 import PprType ( GenType )
36 Patterns come in distinct before- and after-typechecking flavo(u)rs.
39 = WildPatIn -- wild card
40 | VarPatIn name -- variable
41 | LitPatIn HsLit -- literal
42 | LazyPatIn (InPat name) -- lazy pattern
43 | AsPatIn name -- as pattern
45 | ConPatIn name -- constructed type
47 | ConOpPatIn (InPat name)
51 -- We preserve prefix negation and parenthesis for the precedence parser.
53 | NegPatIn (InPat name) -- negated pattern
54 | ParPatIn (InPat name) -- parenthesised pattern
56 | ListPatIn [InPat name] -- syntactic list
57 -- must have >= 1 elements
58 | TuplePatIn [InPat name] -- tuple
60 | RecPatIn name -- record
61 [(name, InPat name, Bool)] -- True <=> source used punning
63 data OutPat tyvar uvar id
64 = WildPat (GenType tyvar uvar) -- wild card
66 | VarPat id -- variable (type is in the Id)
68 | LazyPat (OutPat tyvar uvar id) -- lazy pattern
70 | AsPat id -- as pattern
71 (OutPat tyvar uvar id)
73 | ConPat Id -- Constructor is always an Id
74 (GenType tyvar uvar) -- the type of the pattern
75 [(OutPat tyvar uvar id)]
77 | ConOpPat (OutPat tyvar uvar id) -- just a special case...
79 (OutPat tyvar uvar id)
81 | ListPat -- syntactic list
82 (GenType tyvar uvar) -- the type of the elements
83 [(OutPat tyvar uvar id)]
85 | TuplePat [(OutPat tyvar uvar id)] -- tuple
86 -- UnitPat is TuplePat []
88 | RecPat Id -- record constructor
89 (GenType tyvar uvar) -- the type of the pattern
90 [(id, OutPat tyvar uvar id, Bool)] -- True <=> source used punning
92 | LitPat -- Used for *non-overloaded* literal patterns:
93 -- Int#, Char#, Int, Char, String, etc.
95 (GenType tyvar uvar) -- type of pattern
97 | NPat -- Used for *overloaded* literal patterns
98 HsLit -- the literal is retained so that
99 -- the desugarer can readily identify
100 -- equations with identical literal-patterns
101 (GenType tyvar uvar) -- type of pattern, t
102 (HsExpr tyvar uvar id (OutPat tyvar uvar id))
103 -- of type t -> Bool; detects match
105 | DictPat -- Used when destructing Dictionaries with an explicit case
106 [id] -- superclass dicts
111 instance (Outputable name, NamedThing name) => Outputable (InPat name) where
114 pprInPat :: (Outputable name, NamedThing name) => PprStyle -> InPat name -> Pretty
116 pprInPat sty (WildPatIn) = ppStr "_"
117 pprInPat sty (VarPatIn var) = pprNonOp sty var
118 pprInPat sty (LitPatIn s) = ppr sty s
119 pprInPat sty (LazyPatIn pat) = ppBeside (ppChar '~') (ppr sty pat)
120 pprInPat sty (AsPatIn name pat)
121 = ppBesides [ppLparen, ppr sty name, ppChar '@', ppr sty pat, ppRparen]
123 pprInPat sty (ConPatIn c pats)
127 ppBesides [ppLparen, ppr sty c, ppSP, interppSP sty pats, ppRparen]
130 pprInPat sty (ConOpPatIn pat1 op pat2)
131 = ppBesides [ppLparen, ppr sty pat1, ppSP, ppr sty op, ppSP, ppr sty pat2, ppRparen]
133 -- ToDo: use pprOp to print op (but this involves fiddling various
134 -- contexts & I'm lazy...); *PatIns are *rarely* printed anyway... (WDP)
136 pprInPat sty (NegPatIn pat)
137 = ppBeside (ppChar '-') (ppParens (pprInPat sty pat))
139 pprInPat sty (ParPatIn pat)
140 = ppParens (pprInPat sty pat)
143 pprInPat sty (ListPatIn pats)
144 = ppBesides [ppLbrack, interpp'SP sty pats, ppRbrack]
145 pprInPat sty (TuplePatIn pats)
146 = ppBesides [ppLparen, interpp'SP sty pats, ppRparen]
148 pprInPat sty (RecPatIn con rpats)
149 = ppBesides [ppr sty con, ppSP, ppChar '{', ppInterleave ppComma (map pp_rpat rpats), ppChar '}']
151 pp_rpat (v, _, True{-pun-}) = ppr sty v
152 pp_rpat (v, p, _) = ppCat [ppr sty v, ppStr "<-", ppr sty p]
156 instance (Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar,
157 NamedThing id, Outputable id)
158 => Outputable (OutPat tyvar uvar id) where
163 pprOutPat sty (WildPat ty) = ppChar '_'
164 pprOutPat sty (VarPat var) = pprNonOp sty var
165 pprOutPat sty (LazyPat pat) = ppBesides [ppChar '~', ppr sty pat]
166 pprOutPat sty (AsPat name pat)
167 = ppBesides [ppLparen, ppr sty name, ppChar '@', ppr sty pat, ppRparen]
169 pprOutPat sty (ConPat name ty [])
170 = ppBeside (ppr sty name)
171 (ifPprShowAll sty (pprConPatTy sty ty))
173 pprOutPat sty (ConPat name ty pats)
174 = ppBesides [ppLparen, ppr sty name, ppSP,
175 interppSP sty pats, ppRparen,
176 ifPprShowAll sty (pprConPatTy sty ty) ]
178 pprOutPat sty (ConOpPat pat1 op pat2 ty)
179 = ppBesides [ppLparen, ppr sty pat1, ppSP, pprOp sty op, ppSP, ppr sty pat2, ppRparen]
181 pprOutPat sty (ListPat ty pats)
182 = ppBesides [ppLbrack, interpp'SP sty pats, ppRbrack]
183 pprOutPat sty (TuplePat pats)
184 = ppBesides [ppLparen, interpp'SP sty pats, ppRparen]
186 pprOutPat sty (RecPat con ty rpats)
187 = ppBesides [ppr sty con, ppChar '{', ppInterleave ppComma (map pp_rpat rpats), ppChar '}']
189 -- pp_rpat (v, _, True{-pun-}) = ppr sty v
190 pp_rpat (v, p, _) = ppBesides [ppr sty v, ppStr "<-", ppr sty p]
192 pprOutPat sty (LitPat l ty) = ppr sty l -- ToDo: print more
193 pprOutPat sty (NPat l ty e) = ppr sty l -- ToDo: print more
195 pprOutPat sty (DictPat dicts methods)
196 = ppSep [ppBesides [ppLparen, ppPStr SLIT("{-dict-}")],
197 ppBracket (interpp'SP sty dicts),
198 ppBesides [ppBracket (interpp'SP sty methods), ppRparen]]
201 = ppParens (ppr sty ty)
204 %************************************************************************
206 %* predicates for checking things about pattern-lists in EquationInfo *
208 %************************************************************************
209 \subsection[Pat-list-predicates]{Look for interesting things in patterns}
211 Unlike in the Wadler chapter, where patterns are either ``variables''
212 or ``constructors,'' here we distinguish between:
215 Patterns that cannot fail to match: variables, wildcards, and lazy
218 These are the irrefutable patterns; the two other categories
219 are refutable patterns.
222 A non-literal constructor pattern (see next category).
224 \item[literal patterns:]
225 At least the numeric ones may be overloaded.
228 A pattern is in {\em exactly one} of the above three categories; `as'
229 patterns are treated specially, of course.
232 unfailablePats :: [OutPat a b c] -> Bool
233 unfailablePats pat_list = all unfailablePat pat_list
235 unfailablePat (AsPat _ pat) = unfailablePat pat
236 unfailablePat (WildPat _) = True
237 unfailablePat (VarPat _) = True
238 unfailablePat (LazyPat _) = True
239 unfailablePat (DictPat ds ms) = (length ds + length ms) <= 1
240 unfailablePat other = False
242 patsAreAllCons :: [OutPat a b c] -> Bool
243 patsAreAllCons pat_list = all isConPat pat_list
245 isConPat (AsPat _ pat) = isConPat pat
246 isConPat (ConPat _ _ _) = True
247 isConPat (ConOpPat _ _ _ _) = True
248 isConPat (ListPat _ _) = True
249 isConPat (TuplePat _) = True
250 isConPat (DictPat ds ms) = (length ds + length ms) > 1
251 isConPat other = False
253 patsAreAllLits :: [OutPat a b c] -> Bool
254 patsAreAllLits pat_list = all isLitPat pat_list
256 isLitPat (AsPat _ pat) = isLitPat pat
257 isLitPat (LitPat _ _) = True
258 isLitPat (NPat _ _ _) = True
259 isLitPat other = False
262 A pattern is irrefutable if a match on it cannot fail
265 irrefutablePat :: OutPat a b c -> Bool
267 irrefutablePat (WildPat _) = True
268 irrefutablePat (VarPat _) = True
269 irrefutablePat (LazyPat _) = True
270 irrefutablePat (AsPat _ pat) = irrefutablePat pat
271 irrefutablePat (ConPat con tys pats) = all irrefutablePat pats && only_con con
272 irrefutablePat (ConOpPat pat1 con pat2 _) = irrefutablePat pat1 && irrefutablePat pat1 && only_con con
273 irrefutablePat (ListPat _ _) = False
274 irrefutablePat (TuplePat pats) = all irrefutablePat pats
275 irrefutablePat (DictPat _ _) = True
276 irrefutablePat other_pat = False -- Literals, NPat
278 only_con con = maybeToBool (maybeTyConSingleCon tycon)
280 (_,_,_,tycon) = dataConSig con
283 This function @collectPatBinders@ works with the ``collectBinders''
284 functions for @HsBinds@, etc. The order in which the binders are
285 collected is important; see @HsBinds.lhs@.
287 collectPatBinders :: InPat a -> [a]
289 collectPatBinders (VarPatIn var) = [var]
290 collectPatBinders (LazyPatIn pat) = collectPatBinders pat
291 collectPatBinders (AsPatIn a pat) = a : collectPatBinders pat
292 collectPatBinders (ConPatIn c pats) = concat (map collectPatBinders pats)
293 collectPatBinders (ConOpPatIn p1 c p2)= collectPatBinders p1 ++ collectPatBinders p2
294 collectPatBinders (ListPatIn pats) = concat (map collectPatBinders pats)
295 collectPatBinders (TuplePatIn pats) = concat (map collectPatBinders pats)
296 collectPatBinders any_other_pat = [ {-no binders-} ]