2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
4 \section[PatSyntax]{Abstract Haskell syntax---patterns}
7 #include "HsVersions.h"
11 import AbsPrel ( mkTupleTy, mkListTy
12 IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
13 IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
19 import HsLit ( Literal )
20 import HsExpr ( Expr, TypecheckedExpr(..) )
23 import Maybes ( maybeToBool, Maybe(..) )
25 import ProtoName ( ProtoName(..) ) -- .. for pragmas only
28 import Unique ( Unique )
32 Patterns come in distinct before- and after-typechecking flavo(u)rs.
35 = WildPatIn --X wild card
36 | VarPatIn name --X variable
37 | LitPatIn Literal -- literal
38 | LazyPatIn (InPat name) --X lazy pattern
39 | AsPatIn name --X as pattern
41 | ConPatIn name --X constructed type
43 | ConOpPatIn (InPat name)
46 | ListPatIn [InPat name] --X syntactic list
47 -- must have >= 1 elements
48 | TuplePatIn [InPat name] --X tuple
49 -- UnitPat is TuplePat []
50 | NPlusKPatIn name -- n+k pattern
53 | ProcessorPatIn [(InPat name)]
54 (InPat name) -- (|pat1,...,patK;pat|)
55 #endif {- Data Parallel Haskell -}
57 type ProtoNamePat = InPat ProtoName
58 type RenamedPat = InPat Name
61 = WildPat UniType -- wild card
63 | VarPat Id -- variable (type is in the Id)
65 | LazyPat TypecheckedPat -- lazy pattern
67 | AsPat Id -- as pattern
70 | ConPat Id -- constructed type;
71 UniType -- the type of the pattern
74 | ConOpPat TypecheckedPat -- just a special case...
78 | ListPat -- syntactic list
79 UniType -- the type of the elements
82 | TuplePat [TypecheckedPat] -- tuple
83 -- UnitPat is TuplePat []
85 | LitPat -- Used for *non-overloaded* literal patterns:
86 -- Int#, Char#, Int, Char, String, etc.
88 UniType -- type of pattern
90 | NPat -- Used for *overloaded* literal patterns
91 Literal -- the literal is retained so that
92 -- the desugarer can readily identify
93 -- equations with identical literal-patterns
94 UniType -- type of pattern, t
95 TypecheckedExpr -- Of type t -> Bool; detects match
98 Literal -- Same reason as for LitPat
99 -- (This could be an Integer, but then
100 -- it's harder to partitionEqnsByLit
101 -- in the desugarer.)
102 UniType -- Type of pattern, t
103 TypecheckedExpr -- "fromInteger literal"; of type t
104 TypecheckedExpr -- Of type t-> t -> Bool; detects match
105 TypecheckedExpr -- Of type t -> t -> t; subtracts k
108 [TypecheckedPat] -- Typechecked Pattern
109 [TypecheckedExpr] -- Of type t-> Integer; conversion
110 TypecheckedPat -- Data at that processor
111 #endif {- Data Parallel Haskell -}
114 Note: If @typeOfPat@ doesn't bear a strong resemblance to @typeOfCoreExpr@,
115 then something is wrong.
117 typeOfPat :: TypecheckedPat -> UniType
118 typeOfPat (WildPat ty) = ty
119 typeOfPat (VarPat var) = getIdUniType var
120 typeOfPat (LazyPat pat) = typeOfPat pat
121 typeOfPat (AsPat var pat) = getIdUniType var
122 typeOfPat (ConPat _ ty _) = ty
123 typeOfPat (ConOpPat _ _ _ ty) = ty
124 typeOfPat (ListPat ty _) = mkListTy ty
125 typeOfPat (TuplePat pats) = mkTupleTy (length pats) (map typeOfPat pats)
126 typeOfPat (LitPat lit ty) = ty
127 typeOfPat (NPat lit ty _) = ty
128 typeOfPat (NPlusKPat n k ty _ _ _) = ty
130 -- Should be more efficient to find type of pid than pats
131 typeOfPat (ProcessorPat pats _ pat)
132 = mkProcessorTy (map typeOfPat pats) (typeOfPat pat)
133 #endif {- Data Parallel Haskell -}
137 instance (NamedThing name) => NamedThing (InPat name) where
140 getExportFlag = panic "NamedThing.InPat.getExportFlag"
141 isLocallyDefined = panic "NamedThing.InPat.isLocallyDefined"
142 getOrigName = panic "NamedThing.InPat.getOrigName"
143 getOccurrenceName = panic "NamedThing.InPat.getOccurrenceName"
144 getInformingModules = panic "NamedThing.InPat.getOccurrenceName"
145 getSrcLoc = panic "NamedThing.InPat.getSrcLoc"
146 getTheUnique = panic "NamedThing.InPat.getTheUnique"
147 getType pat = panic "NamedThing.InPat.getType"
148 fromPreludeCore = panic "NamedThing.InPat.fromPreludeCore"
151 instance NamedThing TypecheckedPat where
155 getExportFlag = panic "NamedThing.TypecheckedPat.getExportFlag"
156 isLocallyDefined = panic "NamedThing.TypecheckedPat.isLocallyDefined"
157 getOrigName = panic "NamedThing.TypecheckedPat.getOrigName"
158 getOccurrenceName = panic "NamedThing.TypecheckedPat.getOccurrenceName"
159 getInformingModules = panic "NamedThing.TypecheckedPat.getOccurrenceName"
160 getSrcLoc = panic "NamedThing.TypecheckedPat.getSrcLoc"
161 getTheUnique = panic "NamedThing.TypecheckedPat.getTheUnique"
162 fromPreludeCore = panic "NamedThing.TypecheckedPat.fromPreludeCore"
167 instance (Outputable name) => Outputable (InPat name) where
170 pprInPat :: (Outputable name) => PprStyle -> InPat name -> Pretty
171 pprInPat sty (WildPatIn) = ppStr "_"
172 pprInPat sty (VarPatIn var) = ppr sty var
173 pprInPat sty (LitPatIn s) = ppr sty s
174 pprInPat sty (LazyPatIn pat) = ppBeside (ppChar '~') (ppr sty pat)
175 pprInPat sty (AsPatIn name pat)
176 = ppBesides [ppLparen, ppr sty name, ppChar '@', ppr sty pat, ppRparen]
178 pprInPat sty (ConPatIn c pats)
182 ppBesides [ppLparen, ppr sty c, ppSP, interppSP sty pats, ppRparen]
185 pprInPat sty (ConOpPatIn pat1 op pat2)
186 = ppBesides [ppLparen, ppr sty pat1, ppSP, ppr sty op, ppSP, ppr sty pat2, ppRparen]
188 -- ToDo: use pprOp to print op (but this involves fiddling various
189 -- contexts & I'm lazy...); *PatIns are *rarely* printed anyway... (WDP)
191 pprInPat sty (ListPatIn pats)
192 = ppBesides [ppLbrack, interpp'SP sty pats, ppRbrack]
193 pprInPat sty (TuplePatIn pats)
194 = ppBesides [ppLparen, interpp'SP sty pats, ppRparen]
195 pprInPat sty (NPlusKPatIn n k)
196 = ppBesides [ppLparen, ppr sty n, ppChar '+', ppr sty k, ppRparen]
198 pprInPat sty (ProcessorPatIn pats pat)
199 = ppBesides [ppStr "(|", interpp'SP sty pats,ppSemi ,
200 ppr sty pat , ppStr "|)"]
201 #endif {- Data Parallel Haskell -}
204 Problems with @Outputable@ instance for @TypecheckedPat@ when no
207 instance Outputable TypecheckedPat where
208 ppr = pprTypecheckedPat
212 pprTypecheckedPat sty (WildPat ty) = ppChar '_'
213 pprTypecheckedPat sty (VarPat var) = ppr sty var
214 pprTypecheckedPat sty (LazyPat pat) = ppBesides [ppChar '~', ppr sty pat]
215 pprTypecheckedPat sty (AsPat name pat)
216 = ppBesides [ppLparen, ppr sty name, ppChar '@', ppr sty pat, ppRparen]
218 pprTypecheckedPat sty (ConPat name ty [])
219 = ppBeside (ppr sty name)
220 (ifPprShowAll sty (pprConPatTy sty ty))
222 pprTypecheckedPat sty (ConPat name ty pats)
223 = ppBesides [ppLparen, ppr sty name, ppSP,
224 interppSP sty pats, ppRparen,
225 ifPprShowAll sty (pprConPatTy sty ty) ]
227 pprTypecheckedPat sty (ConOpPat pat1 op pat2 ty)
228 = ppBesides [ppLparen, ppr sty pat1, ppSP, pprOp sty op, ppSP, ppr sty pat2, ppRparen]
230 pprTypecheckedPat sty (ListPat ty pats)
231 = ppBesides [ppLbrack, interpp'SP sty pats, ppRbrack]
232 pprTypecheckedPat sty (TuplePat pats)
233 = ppBesides [ppLparen, interpp'SP sty pats, ppRparen]
235 pprTypecheckedPat sty (LitPat l ty) = ppr sty l -- ToDo: print more
236 pprTypecheckedPat sty (NPat l ty e) = ppr sty l -- ToDo: print more
238 pprTypecheckedPat sty (NPlusKPat n k ty e1 e2 e3)
240 PprForUser -> basic_ppr
241 _ -> ppHang basic_ppr 4 exprs_ppr
243 basic_ppr = ppBesides [ppLparen, ppr sty n, ppChar '+', ppr sty k, ppRparen]
244 exprs_ppr = ppSep [ ppBeside (ppStr "{- ") (ppr sty ty),
245 ppr sty e1, ppr sty e2,
246 ppBeside (ppr sty e3) (ppStr " -}")]
248 pprTypecheckedPat sty (ProcessorPat pats convs pat)
250 PprForUser -> basic_ppr
251 _ -> ppHang basic_ppr 4 exprs_ppr
253 basic_ppr = ppBesides [ppStr "(|", interpp'SP sty pats,ppSemi ,
254 ppr sty pat , ppStr "|)"]
255 exprs_ppr = ppBesides [ppStr "{- " ,
258 #endif {- Data Parallel Haskell -}
260 pprConPatTy :: PprStyle -> UniType -> Pretty
262 = ppBesides [ppLparen, ppr sty ty, ppRparen]
265 %************************************************************************
267 %* predicates for checking things about pattern-lists in EquationInfo *
269 %************************************************************************
270 \subsection[Pat-list-predicates]{Look for interesting things in patterns}
272 Unlike in the Wadler chapter, where patterns are either ``variables''
273 or ``constructors,'' here we distinguish between:
276 Patterns that cannot fail to match: variables, wildcards, and lazy
279 These are the irrefutable patterns; the two other categories
280 are refutable patterns.
283 A non-literal constructor pattern (see next category).
285 \item[literal (including n+k patterns):]
286 At least the numeric ones may be overloaded.
289 A pattern is in {\em exactly one} of the above three categories; `as'
290 patterns are treated specially, of course.
293 unfailablePats :: [TypecheckedPat] -> Bool
294 unfailablePats pat_list = all unfailablePat pat_list
296 unfailablePat (AsPat _ pat) = unfailablePat pat
297 unfailablePat (WildPat _) = True
298 unfailablePat (VarPat _) = True
299 unfailablePat (LazyPat _) = True
300 unfailablePat other = False
302 patsAreAllCons :: [TypecheckedPat] -> Bool
303 patsAreAllCons pat_list = all isConPat pat_list
305 isConPat (AsPat _ pat) = isConPat pat
306 isConPat (ConPat _ _ _) = True
307 isConPat (ConOpPat _ _ _ _) = True
308 isConPat (ListPat _ _) = True
309 isConPat (TuplePat _) = True
311 isConPat (ProcessorPat _ _ _) = True
313 #endif {- Data Parallel Haskell -}
314 isConPat other = False
316 patsAreAllLits :: [TypecheckedPat] -> Bool
317 patsAreAllLits pat_list = all isLitPat pat_list
319 isLitPat (AsPat _ pat) = isLitPat pat
320 isLitPat (LitPat _ _) = True
321 isLitPat (NPat _ _ _) = True
322 isLitPat (NPlusKPat _ _ _ _ _ _)= True
323 isLitPat other = False
326 patsAreAllProcessor :: [TypecheckedPat] -> Bool
327 patsAreAllProcessor pat_list = all isProcessorPat pat_list
329 isProcessorPat (ProcessorPat _ _ _) = True
330 isProcessorPat _ = False
335 -- A pattern is irrefutable if a match on it cannot fail
337 irrefutablePat :: TypecheckedPat -> Bool
339 irrefutablePat (WildPat _) = True
340 irrefutablePat (VarPat _) = True
341 irrefutablePat (LazyPat _) = True
342 irrefutablePat (AsPat _ pat) = irrefutablePat pat
343 irrefutablePat (ConPat con tys pats) = all irrefutablePat pats && only_con con
344 irrefutablePat (ConOpPat pat1 con pat2 _) = irrefutablePat pat1 && irrefutablePat pat1 && only_con con
345 irrefutablePat (ListPat _ _) = False
346 irrefutablePat (TuplePat pats) = all irrefutablePat pats
347 irrefutablePat other_pat = False -- Literals, NPlusK, NPat
349 only_con con = maybeToBool (maybeSingleConstructorTyCon tycon)
351 (_,_,_, tycon) = getDataConSig con