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)
50 | ListPatIn [InPat name] -- syntactic list
51 -- must have >= 1 elements
52 | TuplePatIn [InPat name] -- tuple
54 | RecPatIn name -- record
55 [(name, InPat name, Bool)] -- True <=> source used punning
57 data OutPat tyvar uvar id
58 = WildPat (GenType tyvar uvar) -- wild card
60 | VarPat id -- variable (type is in the Id)
62 | LazyPat (OutPat tyvar uvar id) -- lazy pattern
64 | AsPat id -- as pattern
65 (OutPat tyvar uvar id)
67 | ConPat Id -- Constructor is always an Id
68 (GenType tyvar uvar) -- the type of the pattern
69 [(OutPat tyvar uvar id)]
71 | ConOpPat (OutPat tyvar uvar id) -- just a special case...
73 (OutPat tyvar uvar id)
75 | ListPat -- syntactic list
76 (GenType tyvar uvar) -- the type of the elements
77 [(OutPat tyvar uvar id)]
79 | TuplePat [(OutPat tyvar uvar id)] -- tuple
80 -- UnitPat is TuplePat []
82 | RecPat Id -- record constructor
83 (GenType tyvar uvar) -- the type of the pattern
84 [(id, OutPat tyvar uvar id, Bool)] -- True <=> source used punning
86 | LitPat -- Used for *non-overloaded* literal patterns:
87 -- Int#, Char#, Int, Char, String, etc.
89 (GenType tyvar uvar) -- type of pattern
91 | NPat -- Used for *overloaded* literal patterns
92 HsLit -- the literal is retained so that
93 -- the desugarer can readily identify
94 -- equations with identical literal-patterns
95 (GenType tyvar uvar) -- type of pattern, t
96 (HsExpr tyvar uvar id (OutPat tyvar uvar id))
97 -- of type t -> Bool; detects match
99 | DictPat -- Used when destructing Dictionaries with an explicit case
100 [id] -- superclass dicts
105 instance (Outputable name, NamedThing name) => Outputable (InPat name) where
108 pprInPat :: (Outputable name, NamedThing name) => PprStyle -> InPat name -> Pretty
110 pprInPat sty (WildPatIn) = ppStr "_"
111 pprInPat sty (VarPatIn var) = pprNonOp sty var
112 pprInPat sty (LitPatIn s) = ppr sty s
113 pprInPat sty (LazyPatIn pat) = ppBeside (ppChar '~') (ppr sty pat)
114 pprInPat sty (AsPatIn name pat)
115 = ppBesides [ppLparen, ppr sty name, ppChar '@', ppr sty pat, ppRparen]
117 pprInPat sty (ConPatIn c pats)
121 ppBesides [ppLparen, ppr sty c, ppSP, interppSP sty pats, ppRparen]
124 pprInPat sty (ConOpPatIn pat1 op pat2)
125 = ppBesides [ppLparen, ppr sty pat1, ppSP, ppr sty op, ppSP, ppr sty pat2, ppRparen]
127 -- ToDo: use pprOp to print op (but this involves fiddling various
128 -- contexts & I'm lazy...); *PatIns are *rarely* printed anyway... (WDP)
130 pprInPat sty (ListPatIn pats)
131 = ppBesides [ppLbrack, interpp'SP sty pats, ppRbrack]
132 pprInPat sty (TuplePatIn pats)
133 = ppBesides [ppLparen, interpp'SP sty pats, ppRparen]
135 pprInPat sty (RecPatIn con rpats)
136 = ppBesides [ppr sty con, ppSP, ppChar '{', ppInterleave ppComma (map pp_rpat rpats), ppChar '}']
138 pp_rpat (v, _, True{-pun-}) = ppr sty v
139 pp_rpat (v, p, _) = ppCat [ppr sty v, ppStr "<-", ppr sty p]
143 instance (Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar,
144 NamedThing id, Outputable id)
145 => Outputable (OutPat tyvar uvar id) where
150 pprOutPat sty (WildPat ty) = ppChar '_'
151 pprOutPat sty (VarPat var) = pprNonOp sty var
152 pprOutPat sty (LazyPat pat) = ppBesides [ppChar '~', ppr sty pat]
153 pprOutPat sty (AsPat name pat)
154 = ppBesides [ppLparen, ppr sty name, ppChar '@', ppr sty pat, ppRparen]
156 pprOutPat sty (ConPat name ty [])
157 = ppBeside (ppr sty name)
158 (ifPprShowAll sty (pprConPatTy sty ty))
160 pprOutPat sty (ConPat name ty pats)
161 = ppBesides [ppLparen, ppr sty name, ppSP,
162 interppSP sty pats, ppRparen,
163 ifPprShowAll sty (pprConPatTy sty ty) ]
165 pprOutPat sty (ConOpPat pat1 op pat2 ty)
166 = ppBesides [ppLparen, ppr sty pat1, ppSP, pprOp sty op, ppSP, ppr sty pat2, ppRparen]
168 pprOutPat sty (ListPat ty pats)
169 = ppBesides [ppLbrack, interpp'SP sty pats, ppRbrack]
170 pprOutPat sty (TuplePat pats)
171 = ppBesides [ppLparen, interpp'SP sty pats, ppRparen]
173 pprOutPat sty (RecPat con ty rpats)
174 = ppBesides [ppr sty con, ppChar '{', ppInterleave ppComma (map pp_rpat rpats), ppChar '}']
176 -- pp_rpat (v, _, True{-pun-}) = ppr sty v
177 pp_rpat (v, p, _) = ppBesides [ppr sty v, ppStr "<-", ppr sty p]
179 pprOutPat sty (LitPat l ty) = ppr sty l -- ToDo: print more
180 pprOutPat sty (NPat l ty e) = ppr sty l -- ToDo: print more
182 pprOutPat sty (DictPat dicts methods)
183 = ppSep [ppBesides [ppLparen, ppPStr SLIT("{-dict-}")],
184 ppBracket (interpp'SP sty dicts),
185 ppBesides [ppBracket (interpp'SP sty methods), ppRparen]]
188 = ppBesides [ppLparen, ppr sty ty, ppRparen]
191 %************************************************************************
193 %* predicates for checking things about pattern-lists in EquationInfo *
195 %************************************************************************
196 \subsection[Pat-list-predicates]{Look for interesting things in patterns}
198 Unlike in the Wadler chapter, where patterns are either ``variables''
199 or ``constructors,'' here we distinguish between:
202 Patterns that cannot fail to match: variables, wildcards, and lazy
205 These are the irrefutable patterns; the two other categories
206 are refutable patterns.
209 A non-literal constructor pattern (see next category).
211 \item[literal patterns:]
212 At least the numeric ones may be overloaded.
215 A pattern is in {\em exactly one} of the above three categories; `as'
216 patterns are treated specially, of course.
219 unfailablePats :: [OutPat a b c] -> Bool
220 unfailablePats pat_list = all unfailablePat pat_list
222 unfailablePat (AsPat _ pat) = unfailablePat pat
223 unfailablePat (WildPat _) = True
224 unfailablePat (VarPat _) = True
225 unfailablePat (LazyPat _) = True
226 unfailablePat (DictPat ds ms) = (length ds + length ms) <= 1
227 unfailablePat other = False
229 patsAreAllCons :: [OutPat a b c] -> Bool
230 patsAreAllCons pat_list = all isConPat pat_list
232 isConPat (AsPat _ pat) = isConPat pat
233 isConPat (ConPat _ _ _) = True
234 isConPat (ConOpPat _ _ _ _) = True
235 isConPat (ListPat _ _) = True
236 isConPat (TuplePat _) = True
237 isConPat (DictPat ds ms) = (length ds + length ms) > 1
238 isConPat other = False
240 patsAreAllLits :: [OutPat a b c] -> Bool
241 patsAreAllLits pat_list = all isLitPat pat_list
243 isLitPat (AsPat _ pat) = isLitPat pat
244 isLitPat (LitPat _ _) = True
245 isLitPat (NPat _ _ _) = True
246 isLitPat other = False
249 A pattern is irrefutable if a match on it cannot fail
252 irrefutablePat :: OutPat a b c -> Bool
254 irrefutablePat (WildPat _) = True
255 irrefutablePat (VarPat _) = True
256 irrefutablePat (LazyPat _) = True
257 irrefutablePat (AsPat _ pat) = irrefutablePat pat
258 irrefutablePat (ConPat con tys pats) = all irrefutablePat pats && only_con con
259 irrefutablePat (ConOpPat pat1 con pat2 _) = irrefutablePat pat1 && irrefutablePat pat1 && only_con con
260 irrefutablePat (ListPat _ _) = False
261 irrefutablePat (TuplePat pats) = all irrefutablePat pats
262 irrefutablePat (DictPat _ _) = True
263 irrefutablePat other_pat = False -- Literals, NPat
265 only_con con = maybeToBool (maybeTyConSingleCon tycon)
267 (_,_,_,tycon) = dataConSig con
270 This function @collectPatBinders@ works with the ``collectBinders''
271 functions for @HsBinds@, etc. The order in which the binders are
272 collected is important; see @HsBinds.lhs@.
274 collectPatBinders :: InPat a -> [a]
276 collectPatBinders (VarPatIn var) = [var]
277 collectPatBinders (LazyPatIn pat) = collectPatBinders pat
278 collectPatBinders (AsPatIn a pat) = a : collectPatBinders pat
279 collectPatBinders (ConPatIn c pats) = concat (map collectPatBinders pats)
280 collectPatBinders (ConOpPatIn p1 c p2)= collectPatBinders p1 ++ collectPatBinders p2
281 collectPatBinders (ListPatIn pats) = concat (map collectPatBinders pats)
282 collectPatBinders (TuplePatIn pats) = concat (map collectPatBinders pats)
283 collectPatBinders any_other_pat = [ {-no binders-} ]