2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
5 \section[PatSyntax]{Abstract Haskell syntax---patterns}
8 {-# OPTIONS -fno-warn-incomplete-patterns #-}
9 -- The above warning supression flag is a temporary kludge.
10 -- While working on this module you are encouraged to remove it and fix
11 -- any warnings in the module. See
12 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
16 Pat(..), InPat, OutPat, LPat,
19 HsConPatDetails, hsConPatArgs,
20 HsRecFields(..), HsRecField(..), hsRecFields,
24 mkPrefixConPat, mkCharLitPat, mkNilPat, mkCoPat, mkCoPatCoI,
26 isBangHsBind, hsPatNeedsParens,
27 patsAreAllCons, isConPat, isSigPat, isWildPat,
28 patsAreAllLits, isLitPat, isIrrefutableHsPat, hasViewPat
31 import {-# SOURCE #-} HsExpr (SyntaxExpr, LHsExpr, pprLExpr)
40 import PprCore ( {- instance OutputableBndr TyVar -} )
53 type InPat id = LPat id -- No 'Out' constructors
54 type OutPat id = LPat id -- No 'In' constructors
56 type LPat id = Located (Pat id)
59 = ------------ Simple patterns ---------------
60 WildPat PostTcType -- Wild card
61 -- The sole reason for a type on a WildPat is to
62 -- support hsPatType :: Pat Id -> Type
64 | VarPat id -- Variable
65 | VarPatOut id (DictBinds id) -- Used only for overloaded Ids; the
66 -- bindings give its overloaded instances
67 | LazyPat (LPat id) -- Lazy pattern
68 | AsPat (Located id) (LPat id) -- As pattern
69 | ParPat (LPat id) -- Parenthesised pattern
70 | BangPat (LPat id) -- Bang pattern
72 ------------ Lists, tuples, arrays ---------------
73 | ListPat [LPat id] -- Syntactic list
74 PostTcType -- The type of the elements
76 | TuplePat [LPat id] -- Tuple
77 Boxity -- UnitPat is TuplePat []
79 -- You might think that the PostTcType was redundant, but it's essential
82 -- f :: (T a, a) -> Int
84 -- When desugaring, we must generate
85 -- f = /\a. \v::a. case v of (t::T a, w::a) ->
86 -- case t of (T1 (x::Int)) ->
87 -- Note the (w::a), NOT (w::Int), because we have not yet
88 -- refined 'a' to Int. So we must know that the second component
89 -- of the tuple is of type 'a' not Int. See selectMatchVar
91 | PArrPat [LPat id] -- Syntactic parallel array
92 PostTcType -- The type of the elements
94 ------------ Constructor patterns ---------------
95 | ConPatIn (Located id)
99 pat_con :: Located DataCon,
100 pat_tvs :: [TyVar], -- Existentially bound type variables (tyvars only)
101 pat_dicts :: [id], -- Ditto *coercion variables* and *dictionaries*
102 -- One reason for putting coercion variable here, I think,
103 -- is to ensure their kinds are zonked
104 pat_binds :: DictBinds id, -- Bindings involving those dictionaries
105 pat_args :: HsConPatDetails id,
106 pat_ty :: Type -- The type of the pattern
109 ------------ View patterns ---------------
110 | ViewPat (LHsExpr id)
112 PostTcType -- The overall type of the pattern
113 -- (= the argument type of the view function)
116 ------------ Quasiquoted patterns ---------------
117 -- See Note [Quasi-quote overview] in TcSplice
118 | QuasiQuotePat (HsQuasiQuote id)
120 ------------ Literal and n+k patterns ---------------
121 | LitPat HsLit -- Used for *non-overloaded* literal patterns:
122 -- Int#, Char#, Int, Char, String, etc.
124 | NPat (HsOverLit id) -- ALWAYS positive
125 (Maybe (SyntaxExpr id)) -- Just (Name of 'negate') for negative
126 -- patterns, Nothing otherwise
127 (SyntaxExpr id) -- Equality checker, of type t->t->Bool
129 | NPlusKPat (Located id) -- n+k pattern
130 (HsOverLit id) -- It'll always be an HsIntegral
131 (SyntaxExpr id) -- (>=) function, of type t->t->Bool
132 (SyntaxExpr id) -- Name of '-' (see RnEnv.lookupSyntaxName)
134 ------------ Generics ---------------
135 | TypePat (LHsType id) -- Type pattern for generic definitions
136 -- e.g f{| a+b |} = ...
137 -- These show up only in class declarations,
138 -- and should be a top-level pattern
140 ------------ Pattern type signatures ---------------
141 | SigPatIn (LPat id) -- Pattern with a type signature
144 | SigPatOut (LPat id) -- Pattern with a type signature
147 ------------ Pattern coercions (translation only) ---------------
148 | CoPat HsWrapper -- If co::t1 -> t2, p::t2,
149 -- then (CoPat co p) :: t1
150 (Pat id) -- Why not LPat? Ans: existing locn will do
151 Type -- Type of whole pattern, t1
152 -- During desugaring a (CoPat co pat) turns into a cast with 'co' on
153 -- the scrutinee, followed by a match on 'pat'
156 HsConDetails is use for patterns/expressions *and* for data type declarations
159 data HsConDetails arg rec
160 = PrefixCon [arg] -- C p1 p2 p3
161 | RecCon rec -- C { x = p1, y = p2 }
162 | InfixCon arg arg -- p1 `C` p2
164 type HsConPatDetails id = HsConDetails (LPat id) (HsRecFields id (LPat id))
166 hsConPatArgs :: HsConPatDetails id -> [LPat id]
167 hsConPatArgs (PrefixCon ps) = ps
168 hsConPatArgs (RecCon fs) = map hsRecFieldArg (rec_flds fs)
169 hsConPatArgs (InfixCon p1 p2) = [p1,p2]
172 However HsRecFields is used only for patterns and expressions
173 (not data type declarations)
176 data HsRecFields id arg -- A bunch of record fields
177 -- { x = 3, y = True }
178 -- Used for both expressions and patterns
179 = HsRecFields { rec_flds :: [HsRecField id arg],
180 rec_dotdot :: Maybe Int }
181 -- Nothing => the normal case
182 -- Just n => the group uses ".." notation,
183 -- and the first n elts of rec_flds
184 -- were the user-written ones
185 -- (In the latter case, the remaining elts of
186 -- rec_flds are the non-user-written ones)
188 data HsRecField id arg = HsRecField {
189 hsRecFieldId :: Located id,
190 hsRecFieldArg :: arg,
191 hsRecPun :: Bool -- Note [Punning]
196 -- If you write T { x, y = v+1 }, the HsRecFields will be
197 -- HsRecField x x True ...
198 -- HsRecField y (v+1) False ...
199 -- That is, for "punned" field x is immediately expanded to x=x
200 -- but with a punning flag so we can detect it later
201 -- (e.g. when pretty printing)
203 hsRecFields :: HsRecFields id arg -> [id]
204 hsRecFields rbinds = map (unLoc . hsRecFieldId) (rec_flds rbinds)
208 data HsQuasiQuote id = HsQuasiQuote
214 instance OutputableBndr id => Outputable (HsQuasiQuote id) where
217 ppr_qq :: OutputableBndr id => HsQuasiQuote id -> SDoc
218 ppr_qq (HsQuasiQuote name quoter _ quote) =
219 char '$' <> brackets (ppr name) <>
220 ptext (sLit "[:") <> ppr quoter <> ptext (sLit "|") <>
221 ppr quote <> ptext (sLit "|]")
225 %************************************************************************
229 %************************************************************************
232 instance (OutputableBndr name) => Outputable (Pat name) where
235 pprPatBndr :: OutputableBndr name => name -> SDoc
236 pprPatBndr var -- Print with type info if -dppr-debug is on
237 = getPprStyle $ \ sty ->
238 if debugStyle sty then
239 parens (pprBndr LambdaBind var) -- Could pass the site to pprPat
240 -- but is it worth it?
244 pprPat :: (OutputableBndr name) => Pat name -> SDoc
245 pprPat (VarPat var) = pprPatBndr var
246 pprPat (VarPatOut var bs) = parens (pprPatBndr var <+> braces (ppr bs))
247 pprPat (WildPat _) = char '_'
248 pprPat (LazyPat pat) = char '~' <> ppr pat
249 pprPat (BangPat pat) = char '!' <> ppr pat
250 pprPat (AsPat name pat) = parens (hcat [ppr name, char '@', ppr pat])
251 pprPat (ViewPat expr pat _) = parens (hcat [pprLExpr expr, text " -> ", ppr pat])
252 pprPat (ParPat pat) = parens (ppr pat)
253 pprPat (ListPat pats _) = brackets (interpp'SP pats)
254 pprPat (PArrPat pats _) = pabrackets (interpp'SP pats)
255 pprPat (TuplePat pats bx _) = tupleParens bx (interpp'SP pats)
257 pprPat (ConPatIn con details) = pprUserCon con details
258 pprPat (ConPatOut { pat_con = con, pat_tvs = tvs, pat_dicts = dicts,
259 pat_binds = binds, pat_args = details })
260 = getPprStyle $ \ sty -> -- Tiresome; in TcBinds.tcRhs we print out a
261 if debugStyle sty then -- typechecked Pat in an error message,
262 -- and we want to make sure it prints nicely
263 ppr con <+> sep [ hsep (map pprPatBndr tvs) <+> hsep (map pprPatBndr dicts),
264 pprLHsBinds binds, pprConArgs details]
265 else pprUserCon con details
267 pprPat (LitPat s) = ppr s
268 pprPat (NPat l Nothing _) = ppr l
269 pprPat (NPat l (Just _) _) = char '-' <> ppr l
270 pprPat (NPlusKPat n k _ _) = hcat [ppr n, char '+', ppr k]
271 pprPat (QuasiQuotePat (HsQuasiQuote name quoter _ quote))
272 = char '$' <> brackets (ppr name) <>
273 ptext (sLit "[:") <> ppr quoter <> ptext (sLit "|") <>
274 ppr quote <> ptext (sLit "|]")
275 pprPat (TypePat ty) = ptext (sLit "{|") <> ppr ty <> ptext (sLit "|}")
276 pprPat (CoPat co pat _) = parens (pprHsWrapper (ppr pat) co)
277 pprPat (SigPatIn pat ty) = ppr pat <+> dcolon <+> ppr ty
278 pprPat (SigPatOut pat ty) = ppr pat <+> dcolon <+> ppr ty
280 pprUserCon :: (Outputable con, OutputableBndr id) => con -> HsConPatDetails id -> SDoc
281 pprUserCon c (InfixCon p1 p2) = ppr p1 <+> ppr c <+> ppr p2
282 pprUserCon c details = ppr c <+> pprConArgs details
284 pprConArgs :: OutputableBndr id => HsConPatDetails id -> SDoc
285 pprConArgs (PrefixCon pats) = interppSP pats
286 pprConArgs (InfixCon p1 p2) = interppSP [p1,p2]
287 pprConArgs (RecCon rpats) = ppr rpats
289 instance (OutputableBndr id, Outputable arg)
290 => Outputable (HsRecFields id arg) where
291 ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing })
292 = braces (fsep (punctuate comma (map ppr flds)))
293 ppr (HsRecFields { rec_flds = flds, rec_dotdot = Just n })
294 = braces (fsep (punctuate comma (map ppr (take n flds) ++ [dotdot])))
296 dotdot = ptext (sLit "..") <+> ifPprDebug (ppr (drop n flds))
298 instance (OutputableBndr id, Outputable arg)
299 => Outputable (HsRecField id arg) where
300 ppr (HsRecField { hsRecFieldId = f, hsRecFieldArg = arg,
302 = ppr f <+> (if pun then empty else equals <+> ppr arg)
304 -- add parallel array brackets around a document
306 pabrackets :: SDoc -> SDoc
307 pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")
311 %************************************************************************
315 %************************************************************************
318 mkPrefixConPat :: DataCon -> [OutPat id] -> Type -> OutPat id
319 -- Make a vanilla Prefix constructor pattern
320 mkPrefixConPat dc pats ty
321 = noLoc $ ConPatOut { pat_con = noLoc dc, pat_tvs = [], pat_dicts = [],
322 pat_binds = emptyLHsBinds, pat_args = PrefixCon pats,
325 mkNilPat :: Type -> OutPat id
326 mkNilPat ty = mkPrefixConPat nilDataCon [] ty
328 mkCharLitPat :: Char -> OutPat id
329 mkCharLitPat c = mkPrefixConPat charDataCon [noLoc $ LitPat (HsCharPrim c)] charTy
331 mkCoPat :: HsWrapper -> Pat id -> Type -> Pat id
333 | isIdHsWrapper co = pat
334 | otherwise = CoPat co pat ty
336 mkCoPatCoI :: CoercionI -> Pat id -> Type -> Pat id
337 mkCoPatCoI IdCo pat _ = pat
338 mkCoPatCoI (ACo co) pat ty = mkCoPat (WpCast co) pat ty
342 %************************************************************************
344 %* Predicates for checking things about pattern-lists in EquationInfo *
346 %************************************************************************
348 \subsection[Pat-list-predicates]{Look for interesting things in patterns}
350 Unlike in the Wadler chapter, where patterns are either ``variables''
351 or ``constructors,'' here we distinguish between:
354 Patterns that cannot fail to match: variables, wildcards, and lazy
357 These are the irrefutable patterns; the two other categories
358 are refutable patterns.
361 A non-literal constructor pattern (see next category).
363 \item[literal patterns:]
364 At least the numeric ones may be overloaded.
367 A pattern is in {\em exactly one} of the above three categories; `as'
368 patterns are treated specially, of course.
370 The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
372 hasViewPat :: Pat id -> Bool
373 hasViewPat p = hasViewPat' (L undefined p)
375 hasViewPat' :: LPat id -> Bool
376 hasViewPat' (L _ p) = go p where
377 go (WildPat _) = False
378 go (VarPat _) = False
379 go (VarPatOut _ _) = False
380 go (LazyPat p) = hasViewPat' p
381 go (AsPat _ p) = hasViewPat' p
382 go (ParPat p) = hasViewPat' p
383 go (BangPat p) = hasViewPat' p
384 go (ListPat p _) = any hasViewPat' p
385 go (TuplePat p _ _) = any hasViewPat' p
386 go (PArrPat p _) = any hasViewPat' p
387 go (ConPatIn _ p) = go' p
388 go (ConPatOut _ _ _ _ p _) = go' p
389 go (ViewPat _ _ _) = True
390 go (QuasiQuotePat _) = False
391 go (LitPat _) = False
392 go (NPat _ _ _) = False
393 go (NPlusKPat _ _ _ _) = False
394 go (TypePat _) = False
395 go (SigPatIn p _) = hasViewPat' p
396 go (SigPatOut p _) = hasViewPat' p
397 go (CoPat _ _ _) = False
399 PrefixCon ps -> any hasViewPat' ps
400 RecCon (HsRecFields fs _) -> any (hasViewPat' . hsRecFieldArg) fs
401 InfixCon p1 p2 -> hasViewPat' p1 || hasViewPat' p2
403 isWildPat :: Pat id -> Bool
404 isWildPat (WildPat _) = True
407 patsAreAllCons :: [Pat id] -> Bool
408 patsAreAllCons pat_list = all isConPat pat_list
410 isConPat :: Pat id -> Bool
411 isConPat (AsPat _ pat) = isConPat (unLoc pat)
412 isConPat (ConPatIn {}) = True
413 isConPat (ConPatOut {}) = True
414 isConPat (ListPat {}) = True
415 isConPat (PArrPat {}) = True
416 isConPat (TuplePat {}) = True
419 isSigPat :: Pat id -> Bool
420 isSigPat (SigPatIn _ _) = True
421 isSigPat (SigPatOut _ _) = True
424 patsAreAllLits :: [Pat id] -> Bool
425 patsAreAllLits pat_list = all isLitPat pat_list
427 isLitPat :: Pat id -> Bool
428 isLitPat (AsPat _ pat) = isLitPat (unLoc pat)
429 isLitPat (LitPat _) = True
430 isLitPat (NPat _ _ _) = True
431 isLitPat (NPlusKPat _ _ _ _) = True
434 isBangHsBind :: HsBind id -> Bool
435 -- In this module because HsPat is above HsBinds in the import graph
436 isBangHsBind (PatBind { pat_lhs = L _ (BangPat _) }) = True
437 isBangHsBind _ = False
439 isIrrefutableHsPat :: OutputableBndr id => LPat id -> Bool
440 -- (isIrrefutableHsPat p) is true if matching against p cannot fail,
441 -- in the sense of falling through to the next pattern.
442 -- (NB: this is not quite the same as the (silly) defn
443 -- in 3.17.2 of the Haskell 98 report.)
445 -- isIrrefutableHsPat returns False if it's in doubt; specifically
446 -- on a ConPatIn it doesn't know the size of the constructor family
447 -- But if it returns True, the pattern is definitely irrefutable
448 isIrrefutableHsPat pat
451 go (L _ pat) = go1 pat
453 go1 (WildPat {}) = True
454 go1 (VarPat {}) = True
455 go1 (VarPatOut {}) = True
456 go1 (LazyPat {}) = True
457 go1 (BangPat pat) = go pat
458 go1 (CoPat _ pat _) = go1 pat
459 go1 (ParPat pat) = go pat
460 go1 (AsPat _ pat) = go pat
461 go1 (ViewPat _ pat _) = go pat
462 go1 (SigPatIn pat _) = go pat
463 go1 (SigPatOut pat _) = go pat
464 go1 (TuplePat pats _ _) = all go pats
465 go1 (ListPat {}) = False
466 go1 (PArrPat {}) = False -- ?
468 go1 (ConPatIn {}) = False -- Conservative
469 go1 (ConPatOut{ pat_con = L _ con, pat_args = details })
470 = isProductTyCon (dataConTyCon con)
471 && all go (hsConPatArgs details)
473 go1 (LitPat {}) = False
474 go1 (NPat {}) = False
475 go1 (NPlusKPat {}) = False
477 go1 (QuasiQuotePat {}) = urk pat -- Gotten rid of by renamer, before
478 -- isIrrefutablePat is called
479 go1 (TypePat {}) = urk pat
481 urk pat = pprPanic "isIrrefutableHsPat:" (ppr pat)
483 hsPatNeedsParens :: Pat a -> Bool
484 hsPatNeedsParens (WildPat {}) = False
485 hsPatNeedsParens (VarPat {}) = False
486 hsPatNeedsParens (VarPatOut {}) = True
487 hsPatNeedsParens (LazyPat {}) = False
488 hsPatNeedsParens (BangPat {}) = False
489 hsPatNeedsParens (CoPat {}) = True
490 hsPatNeedsParens (ParPat {}) = False
491 hsPatNeedsParens (AsPat {}) = False
492 hsPatNeedsParens (ViewPat {}) = True
493 hsPatNeedsParens (SigPatIn {}) = True
494 hsPatNeedsParens (SigPatOut {}) = True
495 hsPatNeedsParens (TuplePat {}) = False
496 hsPatNeedsParens (ListPat {}) = False
497 hsPatNeedsParens (PArrPat {}) = False
498 hsPatNeedsParens (ConPatIn _ ds) = conPatNeedsParens ds
499 hsPatNeedsParens (ConPatOut {}) = True
500 hsPatNeedsParens (LitPat {}) = False
501 hsPatNeedsParens (NPat {}) = False
502 hsPatNeedsParens (NPlusKPat {}) = True
503 hsPatNeedsParens (QuasiQuotePat {}) = True
504 hsPatNeedsParens (TypePat {}) = False
506 conPatNeedsParens :: HsConDetails a b -> Bool
507 conPatNeedsParens (PrefixCon args) = not (null args)
508 conPatNeedsParens (InfixCon {}) = False
509 conPatNeedsParens (RecCon {}) = False