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, getDataConSig )
28 import Maybes ( maybeToBool )
30 import PprStyle ( PprStyle(..) )
32 import TyCon ( maybeTyConSingleCon )
33 import TyVar ( GenTyVar )
34 import PprType ( GenType, GenTyVar )
35 import Unique ( Unique )
39 Patterns come in distinct before- and after-typechecking flavo(u)rs.
42 = WildPatIn -- wild card
43 | VarPatIn name -- variable
44 | LitPatIn HsLit -- literal
45 | LazyPatIn (InPat name) -- lazy pattern
46 | AsPatIn name -- as pattern
48 | ConPatIn name -- constructed type
50 | ConOpPatIn (InPat name)
53 | ListPatIn [InPat name] -- syntactic list
54 -- must have >= 1 elements
55 | TuplePatIn [InPat name] -- tuple
57 | RecPatIn name -- record
58 [(name, Maybe (InPat name))]
60 data OutPat tyvar uvar id
61 = WildPat (GenType tyvar uvar) -- wild card
63 | VarPat id -- variable (type is in the Id)
65 | LazyPat (OutPat tyvar uvar id) -- lazy pattern
67 | AsPat id -- as pattern
68 (OutPat tyvar uvar id)
70 | ConPat Id -- Constructor is always an Id
71 (GenType tyvar uvar) -- the type of the pattern
72 [(OutPat tyvar uvar id)]
74 | ConOpPat (OutPat tyvar uvar id) -- just a special case...
76 (OutPat tyvar uvar id)
78 | ListPat -- syntactic list
79 (GenType tyvar uvar) -- the type of the elements
80 [(OutPat tyvar uvar id)]
82 | TuplePat [(OutPat tyvar uvar id)] -- tuple
83 -- UnitPat is TuplePat []
86 [(id, Maybe (OutPat tyvar uvar id))]
88 | LitPat -- Used for *non-overloaded* literal patterns:
89 -- Int#, Char#, Int, Char, String, etc.
91 (GenType tyvar uvar) -- type of pattern
93 | NPat -- Used for *overloaded* literal patterns
94 HsLit -- the literal is retained so that
95 -- the desugarer can readily identify
96 -- equations with identical literal-patterns
97 (GenType tyvar uvar) -- type of pattern, t
98 (HsExpr tyvar uvar id (OutPat tyvar uvar id))
99 -- of type t -> Bool; detects match
101 | DictPat -- Used when destructing Dictionaries with an explicit case
102 [id] -- superclass dicts
107 instance (Outputable name, NamedThing name) => Outputable (InPat name) where
110 pprInPat :: (Outputable name, NamedThing name) => PprStyle -> InPat name -> Pretty
112 pprInPat sty (WildPatIn) = ppStr "_"
113 pprInPat sty (VarPatIn var) = pprNonOp sty var
114 pprInPat sty (LitPatIn s) = ppr sty s
115 pprInPat sty (LazyPatIn pat) = ppBeside (ppChar '~') (ppr sty pat)
116 pprInPat sty (AsPatIn name pat)
117 = ppBesides [ppLparen, ppr sty name, ppChar '@', ppr sty pat, ppRparen]
119 pprInPat sty (ConPatIn c pats)
123 ppBesides [ppLparen, ppr sty c, ppSP, interppSP sty pats, ppRparen]
126 pprInPat sty (ConOpPatIn pat1 op pat2)
127 = ppBesides [ppLparen, ppr sty pat1, ppSP, ppr sty op, ppSP, ppr sty pat2, ppRparen]
129 -- ToDo: use pprOp to print op (but this involves fiddling various
130 -- contexts & I'm lazy...); *PatIns are *rarely* printed anyway... (WDP)
132 pprInPat sty (ListPatIn pats)
133 = ppBesides [ppLbrack, interpp'SP sty pats, ppRbrack]
134 pprInPat sty (TuplePatIn pats)
135 = ppBesides [ppLparen, interpp'SP sty pats, ppRparen]
137 pprInPat sty (RecPatIn con rpats)
138 = ppBesides [ppr sty con, ppSP, ppChar '{', ppInterleave ppComma (map pp_rpat rpats), ppChar '}']
140 pp_rpat (v, Nothing) = ppr sty v
141 pp_rpat (v, Just p) = ppCat [ppr sty v, ppStr "<-", ppr sty p]
145 instance (Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar,
146 NamedThing id, Outputable id)
147 => Outputable (OutPat tyvar uvar id) where
152 pprOutPat sty (WildPat ty) = ppChar '_'
153 pprOutPat sty (VarPat var) = pprNonOp sty var
154 pprOutPat sty (LazyPat pat) = ppBesides [ppChar '~', ppr sty pat]
155 pprOutPat sty (AsPat name pat)
156 = ppBesides [ppLparen, ppr sty name, ppChar '@', ppr sty pat, ppRparen]
158 pprOutPat sty (ConPat name ty [])
159 = ppBeside (ppr sty name)
160 (ifPprShowAll sty (pprConPatTy sty ty))
162 pprOutPat sty (ConPat name ty pats)
163 = ppBesides [ppLparen, ppr sty name, ppSP,
164 interppSP sty pats, ppRparen,
165 ifPprShowAll sty (pprConPatTy sty ty) ]
167 pprOutPat sty (ConOpPat pat1 op pat2 ty)
168 = ppBesides [ppLparen, ppr sty pat1, ppSP, pprOp sty op, ppSP, ppr sty pat2, ppRparen]
170 pprOutPat sty (ListPat ty pats)
171 = ppBesides [ppLbrack, interpp'SP sty pats, ppRbrack]
172 pprOutPat sty (TuplePat pats)
173 = ppBesides [ppLparen, interpp'SP sty pats, ppRparen]
175 pprOutPat sty (RecPat con rpats)
176 = ppBesides [ppr sty con, ppChar '{', ppInterleave ppComma (map pp_rpat rpats), ppChar '}']
178 pp_rpat (v, Nothing) = ppr sty v
179 pp_rpat (v, Just p) = ppBesides [ppr sty v, ppStr "<-", ppr sty p]
181 pprOutPat sty (LitPat l ty) = ppr sty l -- ToDo: print more
182 pprOutPat sty (NPat l ty e) = ppr sty l -- ToDo: print more
184 pprOutPat sty (DictPat dicts methods)
185 = ppSep [ppBesides [ppLparen, ppPStr SLIT("{-dict-}")],
186 ppBracket (interpp'SP sty dicts),
187 ppBesides [ppBracket (interpp'SP sty methods), ppRparen]]
190 = ppBesides [ppLparen, ppr sty ty, ppRparen]
193 %************************************************************************
195 %* predicates for checking things about pattern-lists in EquationInfo *
197 %************************************************************************
198 \subsection[Pat-list-predicates]{Look for interesting things in patterns}
200 Unlike in the Wadler chapter, where patterns are either ``variables''
201 or ``constructors,'' here we distinguish between:
204 Patterns that cannot fail to match: variables, wildcards, and lazy
207 These are the irrefutable patterns; the two other categories
208 are refutable patterns.
211 A non-literal constructor pattern (see next category).
213 \item[literal patterns:]
214 At least the numeric ones may be overloaded.
217 A pattern is in {\em exactly one} of the above three categories; `as'
218 patterns are treated specially, of course.
221 unfailablePats :: [OutPat a b c] -> Bool
222 unfailablePats pat_list = all unfailablePat pat_list
224 unfailablePat (AsPat _ pat) = unfailablePat pat
225 unfailablePat (WildPat _) = True
226 unfailablePat (VarPat _) = True
227 unfailablePat (LazyPat _) = True
228 unfailablePat (DictPat ds ms) = (length ds + length ms) <= 1
229 unfailablePat other = False
231 patsAreAllCons :: [OutPat a b c] -> Bool
232 patsAreAllCons pat_list = all isConPat pat_list
234 isConPat (AsPat _ pat) = isConPat pat
235 isConPat (ConPat _ _ _) = True
236 isConPat (ConOpPat _ _ _ _) = True
237 isConPat (ListPat _ _) = True
238 isConPat (TuplePat _) = True
239 isConPat (DictPat ds ms) = (length ds + length ms) > 1
240 isConPat other = False
242 patsAreAllLits :: [OutPat a b c] -> Bool
243 patsAreAllLits pat_list = all isLitPat pat_list
245 isLitPat (AsPat _ pat) = isLitPat pat
246 isLitPat (LitPat _ _) = True
247 isLitPat (NPat _ _ _) = True
248 isLitPat other = False
251 A pattern is irrefutable if a match on it cannot fail
254 irrefutablePat :: OutPat a b c -> Bool
256 irrefutablePat (WildPat _) = True
257 irrefutablePat (VarPat _) = True
258 irrefutablePat (LazyPat _) = True
259 irrefutablePat (AsPat _ pat) = irrefutablePat pat
260 irrefutablePat (ConPat con tys pats) = all irrefutablePat pats && only_con con
261 irrefutablePat (ConOpPat pat1 con pat2 _) = irrefutablePat pat1 && irrefutablePat pat1 && only_con con
262 irrefutablePat (ListPat _ _) = False
263 irrefutablePat (TuplePat pats) = all irrefutablePat pats
264 irrefutablePat (DictPat _ _) = True
265 irrefutablePat other_pat = False -- Literals, NPat
267 only_con con = maybeToBool (maybeTyConSingleCon tycon)
269 (_,_,_,tycon) = getDataConSig con
272 This function @collectPatBinders@ works with the ``collectBinders''
273 functions for @HsBinds@, etc. The order in which the binders are
274 collected is important; see @HsBinds.lhs@.
276 collectPatBinders :: InPat a -> [a]
278 collectPatBinders (VarPatIn var) = [var]
279 collectPatBinders (LazyPatIn pat) = collectPatBinders pat
280 collectPatBinders (AsPatIn a pat) = a : collectPatBinders pat
281 collectPatBinders (ConPatIn c pats) = concat (map collectPatBinders pats)
282 collectPatBinders (ConOpPatIn p1 c p2)= collectPatBinders p1 ++ collectPatBinders p2
283 collectPatBinders (ListPatIn pats) = concat (map collectPatBinders pats)
284 collectPatBinders (TuplePatIn pats) = concat (map collectPatBinders pats)
285 collectPatBinders any_other_pat = [ {-no binders-} ]