91be1492a808192fec57649f37a4cc7a895cd9c5
[ghc.git] / compiler / hsSyn / HsPat.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5 \section[PatSyntax]{Abstract Haskell syntax---patterns}
6 -}
7
8 {-# LANGUAGE DeriveDataTypeable #-}
9 {-# LANGUAGE DeriveFunctor #-}
10 {-# LANGUAGE DeriveFoldable #-}
11 {-# LANGUAGE DeriveTraversable #-}
12 {-# LANGUAGE StandaloneDeriving #-}
13 {-# LANGUAGE FlexibleContexts #-}
14 {-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
15 -- in module PlaceHolder
16 {-# LANGUAGE ConstraintKinds #-}
17 {-# LANGUAGE TypeFamilies #-}
18 {-# LANGUAGE ViewPatterns #-}
19 {-# LANGUAGE FlexibleInstances #-}
20
21 module HsPat (
22 Pat(..), InPat, OutPat, LPat,
23 ListPatTc(..),
24
25 HsConPatDetails, hsConPatArgs,
26 HsRecFields(..), HsRecField'(..), LHsRecField',
27 HsRecField, LHsRecField,
28 HsRecUpdField, LHsRecUpdField,
29 hsRecFields, hsRecFieldSel, hsRecFieldId, hsRecFieldsArgs,
30 hsRecUpdFieldId, hsRecUpdFieldOcc, hsRecUpdFieldRdr,
31
32 mkPrefixConPat, mkCharLitPat, mkNilPat,
33
34 looksLazyPatBind,
35 isBangedLPat,
36 patNeedsParens, parenthesizePat,
37 isIrrefutableHsPat,
38
39 collectEvVarsPat, collectEvVarsPats,
40
41 pprParendLPat, pprConArgs
42 ) where
43
44 import GhcPrelude
45
46 import {-# SOURCE #-} HsExpr (SyntaxExpr, LHsExpr, HsSplice, pprLExpr, pprSplice)
47
48 -- friends:
49 import HsBinds
50 import HsLit
51 import HsExtension
52 import HsTypes
53 import TcEvidence
54 import BasicTypes
55 -- others:
56 import PprCore ( {- instance OutputableBndr TyVar -} )
57 import TysWiredIn
58 import Var
59 import RdrName ( RdrName )
60 import ConLike
61 import DataCon
62 import TyCon
63 import Outputable
64 import Type
65 import SrcLoc
66 import Bag -- collect ev vars from pats
67 import DynFlags( gopt, GeneralFlag(..) )
68 import Maybes
69 -- libraries:
70 import Data.Data hiding (TyCon,Fixity)
71
72 type InPat p = LPat p -- No 'Out' constructors
73 type OutPat p = LPat p -- No 'In' constructors
74
75 type LPat p = Pat p
76
77 -- | Pattern
78 --
79 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang'
80
81 -- For details on above see note [Api annotations] in ApiAnnotation
82 data Pat p
83 = ------------ Simple patterns ---------------
84 WildPat (XWildPat p) -- ^ Wildcard Pattern
85 -- The sole reason for a type on a WildPat is to
86 -- support hsPatType :: Pat Id -> Type
87
88 -- AZ:TODO above comment needs to be updated
89 | VarPat (XVarPat p)
90 (Located (IdP p)) -- ^ Variable Pattern
91
92 -- See Note [Located RdrNames] in HsExpr
93 | LazyPat (XLazyPat p)
94 (LPat p) -- ^ Lazy Pattern
95 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'
96
97 -- For details on above see note [Api annotations] in ApiAnnotation
98
99 | AsPat (XAsPat p)
100 (Located (IdP p)) (LPat p) -- ^ As pattern
101 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt'
102
103 -- For details on above see note [Api annotations] in ApiAnnotation
104
105 | ParPat (XParPat p)
106 (LPat p) -- ^ Parenthesised pattern
107 -- See Note [Parens in HsSyn] in HsExpr
108 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
109 -- 'ApiAnnotation.AnnClose' @')'@
110
111 -- For details on above see note [Api annotations] in ApiAnnotation
112 | BangPat (XBangPat p)
113 (LPat p) -- ^ Bang pattern
114 -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang'
115
116 -- For details on above see note [Api annotations] in ApiAnnotation
117
118 ------------ Lists, tuples, arrays ---------------
119 | ListPat (XListPat p)
120 [LPat p]
121 -- For OverloadedLists a Just (ty,fn) gives
122 -- overall type of the pattern, and the toList
123 -- function to convert the scrutinee to a list value
124
125 -- ^ Syntactic List
126 --
127 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
128 -- 'ApiAnnotation.AnnClose' @']'@
129
130 -- For details on above see note [Api annotations] in ApiAnnotation
131
132 | TuplePat (XTuplePat p)
133 -- after typechecking, holds the types of the tuple components
134 [LPat p] -- Tuple sub-patterns
135 Boxity -- UnitPat is TuplePat []
136 -- You might think that the post typechecking Type was redundant,
137 -- because we can get the pattern type by getting the types of the
138 -- sub-patterns.
139 -- But it's essential
140 -- data T a where
141 -- T1 :: Int -> T Int
142 -- f :: (T a, a) -> Int
143 -- f (T1 x, z) = z
144 -- When desugaring, we must generate
145 -- f = /\a. \v::a. case v of (t::T a, w::a) ->
146 -- case t of (T1 (x::Int)) ->
147 -- Note the (w::a), NOT (w::Int), because we have not yet
148 -- refined 'a' to Int. So we must know that the second component
149 -- of the tuple is of type 'a' not Int. See selectMatchVar
150 -- (June 14: I'm not sure this comment is right; the sub-patterns
151 -- will be wrapped in CoPats, no?)
152 -- ^ Tuple sub-patterns
153 --
154 -- - 'ApiAnnotation.AnnKeywordId' :
155 -- 'ApiAnnotation.AnnOpen' @'('@ or @'(#'@,
156 -- 'ApiAnnotation.AnnClose' @')'@ or @'#)'@
157
158 | SumPat (XSumPat p) -- PlaceHolder before typechecker, filled in
159 -- afterwards with the types of the
160 -- alternative
161 (LPat p) -- Sum sub-pattern
162 ConTag -- Alternative (one-based)
163 Arity -- Arity (INVARIANT: ≥ 2)
164 -- ^ Anonymous sum pattern
165 --
166 -- - 'ApiAnnotation.AnnKeywordId' :
167 -- 'ApiAnnotation.AnnOpen' @'(#'@,
168 -- 'ApiAnnotation.AnnClose' @'#)'@
169
170 -- For details on above see note [Api annotations] in ApiAnnotation
171
172 ------------ Constructor patterns ---------------
173 | ConPatIn (Located (IdP p))
174 (HsConPatDetails p)
175 -- ^ Constructor Pattern In
176
177 | ConPatOut {
178 pat_con :: Located ConLike,
179 pat_arg_tys :: [Type], -- The universal arg types, 1-1 with the universal
180 -- tyvars of the constructor/pattern synonym
181 -- Use (conLikeResTy pat_con pat_arg_tys) to get
182 -- the type of the pattern
183
184 pat_tvs :: [TyVar], -- Existentially bound type variables
185 -- in correctly-scoped order e.g. [k:*, x:k]
186 pat_dicts :: [EvVar], -- Ditto *coercion variables* and *dictionaries*
187 -- One reason for putting coercion variable here, I think,
188 -- is to ensure their kinds are zonked
189
190 pat_binds :: TcEvBinds, -- Bindings involving those dictionaries
191 pat_args :: HsConPatDetails p,
192 pat_wrap :: HsWrapper -- Extra wrapper to pass to the matcher
193 -- Only relevant for pattern-synonyms;
194 -- ignored for data cons
195 }
196 -- ^ Constructor Pattern Out
197
198 ------------ View patterns ---------------
199 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'
200
201 -- For details on above see note [Api annotations] in ApiAnnotation
202 | ViewPat (XViewPat p) -- The overall type of the pattern
203 -- (= the argument type of the view function)
204 -- for hsPatType.
205 (LHsExpr p)
206 (LPat p)
207 -- ^ View Pattern
208
209 ------------ Pattern splices ---------------
210 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'$('@
211 -- 'ApiAnnotation.AnnClose' @')'@
212
213 -- For details on above see note [Api annotations] in ApiAnnotation
214 | SplicePat (XSplicePat p)
215 (HsSplice p) -- ^ Splice Pattern (Includes quasi-quotes)
216
217 ------------ Literal and n+k patterns ---------------
218 | LitPat (XLitPat p)
219 (HsLit p) -- ^ Literal Pattern
220 -- Used for *non-overloaded* literal patterns:
221 -- Int#, Char#, Int, Char, String, etc.
222
223 | NPat -- Natural Pattern
224 -- Used for all overloaded literals,
225 -- including overloaded strings with -XOverloadedStrings
226 (XNPat p) -- Overall type of pattern. Might be
227 -- different than the literal's type
228 -- if (==) or negate changes the type
229 (Located (HsOverLit p)) -- ALWAYS positive
230 (Maybe (SyntaxExpr p)) -- Just (Name of 'negate') for
231 -- negative patterns, Nothing
232 -- otherwise
233 (SyntaxExpr p) -- Equality checker, of type t->t->Bool
234
235 -- ^ Natural Pattern
236 --
237 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVal' @'+'@
238
239 -- For details on above see note [Api annotations] in ApiAnnotation
240 | NPlusKPat (XNPlusKPat p) -- Type of overall pattern
241 (Located (IdP p)) -- n+k pattern
242 (Located (HsOverLit p)) -- It'll always be an HsIntegral
243 (HsOverLit p) -- See Note [NPlusK patterns] in TcPat
244 -- NB: This could be (PostTc ...), but that induced a
245 -- a new hs-boot file. Not worth it.
246
247 (SyntaxExpr p) -- (>=) function, of type t1->t2->Bool
248 (SyntaxExpr p) -- Name of '-' (see RnEnv.lookupSyntaxName)
249 -- ^ n+k pattern
250
251 ------------ Pattern type signatures ---------------
252 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
253
254 -- For details on above see note [Api annotations] in ApiAnnotation
255 | SigPat (XSigPat p) -- After typechecker: Type
256 (LPat p) -- Pattern with a type signature
257 (LHsSigWcType (NoGhcTc p)) -- Signature can bind both
258 -- kind and type vars
259
260 -- ^ Pattern with a type signature
261
262 ------------ Pattern coercions (translation only) ---------------
263 | CoPat (XCoPat p)
264 HsWrapper -- Coercion Pattern
265 -- If co :: t1 ~ t2, p :: t2,
266 -- then (CoPat co p) :: t1
267 (Pat p) -- Why not LPat? Ans: existing locn will do
268 Type -- Type of whole pattern, t1
269 -- During desugaring a (CoPat co pat) turns into a cast with 'co' on
270 -- the scrutinee, followed by a match on 'pat'
271 -- ^ Coercion Pattern
272
273 -- | Trees that Grow extension point for new constructors
274 | XPat
275 (XXPat p)
276
277 -- ---------------------------------------------------------------------
278
279 data ListPatTc
280 = ListPatTc
281 Type -- The type of the elements
282 (Maybe (Type, SyntaxExpr GhcTc)) -- For rebindable syntax
283
284 type instance XWildPat GhcPs = NoExt
285 type instance XWildPat GhcRn = NoExt
286 type instance XWildPat GhcTc = Type
287
288 type instance XVarPat (GhcPass _) = NoExt
289 type instance XLazyPat (GhcPass _) = NoExt
290 type instance XAsPat (GhcPass _) = NoExt
291 type instance XParPat (GhcPass _) = NoExt
292 type instance XBangPat (GhcPass _) = NoExt
293
294 -- Note: XListPat cannot be extended when using GHC 8.0.2 as the bootstrap
295 -- compiler, as it triggers https://ghc.haskell.org/trac/ghc/ticket/14396 for
296 -- `SyntaxExpr`
297 type instance XListPat GhcPs = NoExt
298 type instance XListPat GhcRn = Maybe (SyntaxExpr GhcRn)
299 type instance XListPat GhcTc = ListPatTc
300
301 type instance XTuplePat GhcPs = NoExt
302 type instance XTuplePat GhcRn = NoExt
303 type instance XTuplePat GhcTc = [Type]
304
305 type instance XSumPat GhcPs = NoExt
306 type instance XSumPat GhcRn = NoExt
307 type instance XSumPat GhcTc = [Type]
308
309 type instance XViewPat GhcPs = NoExt
310 type instance XViewPat GhcRn = NoExt
311 type instance XViewPat GhcTc = Type
312
313 type instance XSplicePat (GhcPass _) = NoExt
314 type instance XLitPat (GhcPass _) = NoExt
315
316 type instance XNPat GhcPs = NoExt
317 type instance XNPat GhcRn = NoExt
318 type instance XNPat GhcTc = Type
319
320 type instance XNPlusKPat GhcPs = NoExt
321 type instance XNPlusKPat GhcRn = NoExt
322 type instance XNPlusKPat GhcTc = Type
323
324 type instance XSigPat GhcPs = NoExt
325 type instance XSigPat GhcRn = NoExt
326 type instance XSigPat GhcTc = Type
327
328 type instance XCoPat (GhcPass _) = NoExt
329 type instance XXPat (GhcPass p) = Located (Pat (GhcPass p))
330
331
332 {-
333 ************************************************************************
334 * *
335 * HasSrcSpan Instance
336 * *
337 ************************************************************************
338 -}
339
340 type instance SrcSpanLess (LPat (GhcPass p)) = Pat (GhcPass p)
341 instance HasSrcSpan (LPat (GhcPass p)) where
342 -- NB: The following chooses the behaviour of the outer location
343 -- wrapper replacing the inner ones.
344 composeSrcSpan (L sp p) = if sp == noSrcSpan
345 then p
346 else XPat (L sp (stripSrcSpanPat p))
347
348 -- NB: The following only returns the top-level location, if any.
349 decomposeSrcSpan (XPat (L sp p)) = L sp (stripSrcSpanPat p)
350 decomposeSrcSpan p = L noSrcSpan p
351
352 stripSrcSpanPat :: LPat (GhcPass p) -> Pat (GhcPass p)
353 stripSrcSpanPat (XPat (L _ p)) = stripSrcSpanPat p
354 stripSrcSpanPat p = p
355
356
357
358 -- ---------------------------------------------------------------------
359
360
361 -- | Haskell Constructor Pattern Details
362 type HsConPatDetails p = HsConDetails (LPat p) (HsRecFields p (LPat p))
363
364 hsConPatArgs :: HsConPatDetails p -> [LPat p]
365 hsConPatArgs (PrefixCon ps) = ps
366 hsConPatArgs (RecCon fs) = map (hsRecFieldArg . unLoc) (rec_flds fs)
367 hsConPatArgs (InfixCon p1 p2) = [p1,p2]
368
369 -- | Haskell Record Fields
370 --
371 -- HsRecFields is used only for patterns and expressions (not data type
372 -- declarations)
373 data HsRecFields p arg -- A bunch of record fields
374 -- { x = 3, y = True }
375 -- Used for both expressions and patterns
376 = HsRecFields { rec_flds :: [LHsRecField p arg],
377 rec_dotdot :: Maybe (Located Int) } -- Note [DotDot fields]
378 deriving (Functor, Foldable, Traversable)
379
380
381 -- Note [DotDot fields]
382 -- ~~~~~~~~~~~~~~~~~~~~
383 -- The rec_dotdot field means this:
384 -- Nothing => the normal case
385 -- Just n => the group uses ".." notation,
386 --
387 -- In the latter case:
388 --
389 -- *before* renamer: rec_flds are exactly the n user-written fields
390 --
391 -- *after* renamer: rec_flds includes *all* fields, with
392 -- the first 'n' being the user-written ones
393 -- and the remainder being 'filled in' implicitly
394
395 -- | Located Haskell Record Field
396 type LHsRecField' p arg = Located (HsRecField' p arg)
397
398 -- | Located Haskell Record Field
399 type LHsRecField p arg = Located (HsRecField p arg)
400
401 -- | Located Haskell Record Update Field
402 type LHsRecUpdField p = Located (HsRecUpdField p)
403
404 -- | Haskell Record Field
405 type HsRecField p arg = HsRecField' (FieldOcc p) arg
406
407 -- | Haskell Record Update Field
408 type HsRecUpdField p = HsRecField' (AmbiguousFieldOcc p) (LHsExpr p)
409
410 -- | Haskell Record Field
411 --
412 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual',
413 --
414 -- For details on above see note [Api annotations] in ApiAnnotation
415 data HsRecField' id arg = HsRecField {
416 hsRecFieldLbl :: Located id,
417 hsRecFieldArg :: arg, -- ^ Filled in by renamer when punning
418 hsRecPun :: Bool -- ^ Note [Punning]
419 } deriving (Data, Functor, Foldable, Traversable)
420
421
422 -- Note [Punning]
423 -- ~~~~~~~~~~~~~~
424 -- If you write T { x, y = v+1 }, the HsRecFields will be
425 -- HsRecField x x True ...
426 -- HsRecField y (v+1) False ...
427 -- That is, for "punned" field x is expanded (in the renamer)
428 -- to x=x; but with a punning flag so we can detect it later
429 -- (e.g. when pretty printing)
430 --
431 -- If the original field was qualified, we un-qualify it, thus
432 -- T { A.x } means T { A.x = x }
433
434
435 -- Note [HsRecField and HsRecUpdField]
436 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
437
438 -- A HsRecField (used for record construction and pattern matching)
439 -- contains an unambiguous occurrence of a field (i.e. a FieldOcc).
440 -- We can't just store the Name, because thanks to
441 -- DuplicateRecordFields this may not correspond to the label the user
442 -- wrote.
443 --
444 -- A HsRecUpdField (used for record update) contains a potentially
445 -- ambiguous occurrence of a field (an AmbiguousFieldOcc). The
446 -- renamer will fill in the selector function if it can, but if the
447 -- selector is ambiguous the renamer will defer to the typechecker.
448 -- After the typechecker, a unique selector will have been determined.
449 --
450 -- The renamer produces an Unambiguous result if it can, rather than
451 -- just doing the lookup in the typechecker, so that completely
452 -- unambiguous updates can be represented by 'DsMeta.repUpdFields'.
453 --
454 -- For example, suppose we have:
455 --
456 -- data S = MkS { x :: Int }
457 -- data T = MkT { x :: Int }
458 --
459 -- f z = (z { x = 3 }) :: S
460 --
461 -- The parsed HsRecUpdField corresponding to the record update will have:
462 --
463 -- hsRecFieldLbl = Unambiguous "x" NoExt :: AmbiguousFieldOcc RdrName
464 --
465 -- After the renamer, this will become:
466 --
467 -- hsRecFieldLbl = Ambiguous "x" NoExt :: AmbiguousFieldOcc Name
468 --
469 -- (note that the Unambiguous constructor is not type-correct here).
470 -- The typechecker will determine the particular selector:
471 --
472 -- hsRecFieldLbl = Unambiguous "x" $sel:x:MkS :: AmbiguousFieldOcc Id
473 --
474 -- See also Note [Disambiguating record fields] in TcExpr.
475
476 hsRecFields :: HsRecFields p arg -> [XCFieldOcc p]
477 hsRecFields rbinds = map (unLoc . hsRecFieldSel . unLoc) (rec_flds rbinds)
478
479 -- Probably won't typecheck at once, things have changed :/
480 hsRecFieldsArgs :: HsRecFields p arg -> [arg]
481 hsRecFieldsArgs rbinds = map (hsRecFieldArg . unLoc) (rec_flds rbinds)
482
483 hsRecFieldSel :: HsRecField pass arg -> Located (XCFieldOcc pass)
484 hsRecFieldSel = fmap extFieldOcc . hsRecFieldLbl
485
486 hsRecFieldId :: HsRecField GhcTc arg -> Located Id
487 hsRecFieldId = hsRecFieldSel
488
489 hsRecUpdFieldRdr :: HsRecUpdField (GhcPass p) -> Located RdrName
490 hsRecUpdFieldRdr = fmap rdrNameAmbiguousFieldOcc . hsRecFieldLbl
491
492 hsRecUpdFieldId :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> Located Id
493 hsRecUpdFieldId = fmap extFieldOcc . hsRecUpdFieldOcc
494
495 hsRecUpdFieldOcc :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc
496 hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hsRecFieldLbl
497
498
499 {-
500 ************************************************************************
501 * *
502 * Printing patterns
503 * *
504 ************************************************************************
505 -}
506
507 instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (Pat p) where
508 ppr = pprPat
509
510 pprPatBndr :: OutputableBndr name => name -> SDoc
511 pprPatBndr var -- Print with type info if -dppr-debug is on
512 = getPprStyle $ \ sty ->
513 if debugStyle sty then
514 parens (pprBndr LambdaBind var) -- Could pass the site to pprPat
515 -- but is it worth it?
516 else
517 pprPrefixOcc var
518
519 pprParendLPat :: (OutputableBndrId (GhcPass p))
520 => PprPrec -> LPat (GhcPass p) -> SDoc
521 pprParendLPat p = pprParendPat p . unLoc
522
523 pprParendPat :: (OutputableBndrId (GhcPass p))
524 => PprPrec -> Pat (GhcPass p) -> SDoc
525 pprParendPat p pat = sdocWithDynFlags $ \ dflags ->
526 if need_parens dflags pat
527 then parens (pprPat pat)
528 else pprPat pat
529 where
530 need_parens dflags pat
531 | CoPat {} <- pat = gopt Opt_PrintTypecheckerElaboration dflags
532 | otherwise = patNeedsParens p pat
533 -- For a CoPat we need parens if we are going to show it, which
534 -- we do if -fprint-typechecker-elaboration is on (c.f. pprHsWrapper)
535 -- But otherwise the CoPat is discarded, so it
536 -- is the pattern inside that matters. Sigh.
537
538 pprPat :: (OutputableBndrId (GhcPass p)) => Pat (GhcPass p) -> SDoc
539 pprPat (VarPat _ lvar) = pprPatBndr (unLoc lvar)
540 pprPat (WildPat _) = char '_'
541 pprPat (LazyPat _ pat) = char '~' <> pprParendLPat appPrec pat
542 pprPat (BangPat _ pat) = char '!' <> pprParendLPat appPrec pat
543 pprPat (AsPat _ name pat) = hcat [pprPrefixOcc (unLoc name), char '@',
544 pprParendLPat appPrec pat]
545 pprPat (ViewPat _ expr pat) = hcat [pprLExpr expr, text " -> ", ppr pat]
546 pprPat (ParPat _ pat) = parens (ppr pat)
547 pprPat (LitPat _ s) = ppr s
548 pprPat (NPat _ l Nothing _) = ppr l
549 pprPat (NPat _ l (Just _) _) = char '-' <> ppr l
550 pprPat (NPlusKPat _ n k _ _ _) = hcat [ppr n, char '+', ppr k]
551 pprPat (SplicePat _ splice) = pprSplice splice
552 pprPat (CoPat _ co pat _) = pprHsWrapper co $ \parens
553 -> if parens
554 then pprParendPat appPrec pat
555 else pprPat pat
556 pprPat (SigPat _ pat ty) = ppr pat <+> dcolon <+> ppr ty
557 pprPat (ListPat _ pats) = brackets (interpp'SP pats)
558 pprPat (TuplePat _ pats bx) = tupleParens (boxityTupleSort bx)
559 (pprWithCommas ppr pats)
560 pprPat (SumPat _ pat alt arity) = sumParens (pprAlternative ppr pat alt arity)
561 pprPat (ConPatIn con details) = pprUserCon (unLoc con) details
562 pprPat (ConPatOut { pat_con = con
563 , pat_tvs = tvs
564 , pat_dicts = dicts
565 , pat_binds = binds
566 , pat_args = details })
567 = sdocWithDynFlags $ \dflags ->
568 -- Tiresome; in TcBinds.tcRhs we print out a
569 -- typechecked Pat in an error message,
570 -- and we want to make sure it prints nicely
571 if gopt Opt_PrintTypecheckerElaboration dflags then
572 ppr con
573 <> braces (sep [ hsep (map pprPatBndr (tvs ++ dicts))
574 , ppr binds])
575 <+> pprConArgs details
576 else pprUserCon (unLoc con) details
577 pprPat (XPat x) = ppr x
578
579
580 pprUserCon :: (OutputableBndr con, OutputableBndrId (GhcPass p))
581 => con -> HsConPatDetails (GhcPass p) -> SDoc
582 pprUserCon c (InfixCon p1 p2) = ppr p1 <+> pprInfixOcc c <+> ppr p2
583 pprUserCon c details = pprPrefixOcc c <+> pprConArgs details
584
585 pprConArgs :: (OutputableBndrId (GhcPass p))
586 => HsConPatDetails (GhcPass p) -> SDoc
587 pprConArgs (PrefixCon pats) = sep (map (pprParendLPat appPrec) pats)
588 pprConArgs (InfixCon p1 p2) = sep [ pprParendLPat appPrec p1
589 , pprParendLPat appPrec p2 ]
590 pprConArgs (RecCon rpats) = ppr rpats
591
592 instance (Outputable arg)
593 => Outputable (HsRecFields p arg) where
594 ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing })
595 = braces (fsep (punctuate comma (map ppr flds)))
596 ppr (HsRecFields { rec_flds = flds, rec_dotdot = Just (unLoc -> n) })
597 = braces (fsep (punctuate comma (map ppr (take n flds) ++ [dotdot])))
598 where
599 dotdot = text ".." <+> whenPprDebug (ppr (drop n flds))
600
601 instance (Outputable p, Outputable arg)
602 => Outputable (HsRecField' p arg) where
603 ppr (HsRecField { hsRecFieldLbl = f, hsRecFieldArg = arg,
604 hsRecPun = pun })
605 = ppr f <+> (ppUnless pun $ equals <+> ppr arg)
606
607
608 {-
609 ************************************************************************
610 * *
611 * Building patterns
612 * *
613 ************************************************************************
614 -}
615
616 mkPrefixConPat :: DataCon ->
617 [OutPat (GhcPass p)] -> [Type] -> OutPat (GhcPass p)
618 -- Make a vanilla Prefix constructor pattern
619 mkPrefixConPat dc pats tys
620 = noLoc $ ConPatOut { pat_con = noLoc (RealDataCon dc)
621 , pat_tvs = []
622 , pat_dicts = []
623 , pat_binds = emptyTcEvBinds
624 , pat_args = PrefixCon pats
625 , pat_arg_tys = tys
626 , pat_wrap = idHsWrapper }
627
628 mkNilPat :: Type -> OutPat (GhcPass p)
629 mkNilPat ty = mkPrefixConPat nilDataCon [] [ty]
630
631 mkCharLitPat :: SourceText -> Char -> OutPat (GhcPass p)
632 mkCharLitPat src c = mkPrefixConPat charDataCon
633 [noLoc $ LitPat NoExt (HsCharPrim src c)] []
634
635 {-
636 ************************************************************************
637 * *
638 * Predicates for checking things about pattern-lists in EquationInfo *
639 * *
640 ************************************************************************
641
642 \subsection[Pat-list-predicates]{Look for interesting things in patterns}
643
644 Unlike in the Wadler chapter, where patterns are either ``variables''
645 or ``constructors,'' here we distinguish between:
646 \begin{description}
647 \item[unfailable:]
648 Patterns that cannot fail to match: variables, wildcards, and lazy
649 patterns.
650
651 These are the irrefutable patterns; the two other categories
652 are refutable patterns.
653
654 \item[constructor:]
655 A non-literal constructor pattern (see next category).
656
657 \item[literal patterns:]
658 At least the numeric ones may be overloaded.
659 \end{description}
660
661 A pattern is in {\em exactly one} of the above three categories; `as'
662 patterns are treated specially, of course.
663
664 The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
665 -}
666
667 isBangedLPat :: LPat (GhcPass p) -> Bool
668 isBangedLPat = isBangedPat . unLoc
669
670 isBangedPat :: Pat (GhcPass p) -> Bool
671 isBangedPat (ParPat _ p) = isBangedLPat p
672 isBangedPat (BangPat {}) = True
673 isBangedPat _ = False
674
675 looksLazyPatBind :: HsBind (GhcPass p) -> Bool
676 -- Returns True of anything *except*
677 -- a StrictHsBind (as above) or
678 -- a VarPat
679 -- In particular, returns True of a pattern binding with a compound pattern, like (I# x)
680 -- Looks through AbsBinds
681 looksLazyPatBind (PatBind { pat_lhs = p })
682 = looksLazyLPat p
683 looksLazyPatBind (AbsBinds { abs_binds = binds })
684 = anyBag (looksLazyPatBind . unLoc) binds
685 looksLazyPatBind _
686 = False
687
688 looksLazyLPat :: LPat (GhcPass p) -> Bool
689 looksLazyLPat = looksLazyPat . unLoc
690
691 looksLazyPat :: Pat (GhcPass p) -> Bool
692 looksLazyPat (ParPat _ p) = looksLazyLPat p
693 looksLazyPat (AsPat _ _ p) = looksLazyLPat p
694 looksLazyPat (BangPat {}) = False
695 looksLazyPat (VarPat {}) = False
696 looksLazyPat (WildPat {}) = False
697 looksLazyPat _ = True
698
699 isIrrefutableHsPat :: (OutputableBndrId (GhcPass p)) => LPat (GhcPass p) -> Bool
700 -- (isIrrefutableHsPat p) is true if matching against p cannot fail,
701 -- in the sense of falling through to the next pattern.
702 -- (NB: this is not quite the same as the (silly) defn
703 -- in 3.17.2 of the Haskell 98 report.)
704 --
705 -- WARNING: isIrrefutableHsPat returns False if it's in doubt.
706 -- Specifically on a ConPatIn, which is what it sees for a
707 -- (LPat Name) in the renamer, it doesn't know the size of the
708 -- constructor family, so it returns False. Result: only
709 -- tuple patterns are considered irrefuable at the renamer stage.
710 --
711 -- But if it returns True, the pattern is definitely irrefutable
712 isIrrefutableHsPat
713 = goL
714 where
715 goL = go . unLoc
716
717 go (WildPat {}) = True
718 go (VarPat {}) = True
719 go (LazyPat {}) = True
720 go (BangPat _ pat) = goL pat
721 go (CoPat _ _ pat _) = go pat
722 go (ParPat _ pat) = goL pat
723 go (AsPat _ _ pat) = goL pat
724 go (ViewPat _ _ pat) = goL pat
725 go (SigPat _ pat _) = goL pat
726 go (TuplePat _ pats _) = all goL pats
727 go (SumPat {}) = False
728 -- See Note [Unboxed sum patterns aren't irrefutable]
729 go (ListPat {}) = False
730
731 go (ConPatIn {}) = False -- Conservative
732 go (ConPatOut
733 { pat_con = (dL->L _ (RealDataCon con))
734 , pat_args = details })
735 =
736 isJust (tyConSingleDataCon_maybe (dataConTyCon con))
737 -- NB: tyConSingleDataCon_maybe, *not* isProductTyCon, because
738 -- the latter is false of existentials. See Trac #4439
739 && all goL (hsConPatArgs details)
740 go (ConPatOut
741 { pat_con = (dL->L _ (PatSynCon _pat)) })
742 = False -- Conservative
743 go (ConPatOut{}) = panic "ConPatOut:Impossible Match" -- due to #15884
744 go (LitPat {}) = False
745 go (NPat {}) = False
746 go (NPlusKPat {}) = False
747
748 -- We conservatively assume that no TH splices are irrefutable
749 -- since we cannot know until the splice is evaluated.
750 go (SplicePat {}) = False
751
752 go (XPat {}) = False
753
754 {- Note [Unboxed sum patterns aren't irrefutable]
755 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
756 Unlike unboxed tuples, unboxed sums are *not* irrefutable when used as
757 patterns. A simple example that demonstrates this is from #14228:
758
759 pattern Just' x = (# x | #)
760 pattern Nothing' = (# | () #)
761
762 foo x = case x of
763 Nothing' -> putStrLn "nothing"
764 Just' -> putStrLn "just"
765
766 In foo, the pattern Nothing' (that is, (# x | #)) is certainly not irrefutable,
767 as does not match an unboxed sum value of the same arity—namely, (# | y #)
768 (covered by Just'). In fact, no unboxed sum pattern is irrefutable, since the
769 minimum unboxed sum arity is 2.
770
771 Failing to mark unboxed sum patterns as non-irrefutable would cause the Just'
772 case in foo to be unreachable, as GHC would mistakenly believe that Nothing'
773 is the only thing that could possibly be matched!
774 -}
775
776 -- | @'patNeedsParens' p pat@ returns 'True' if the pattern @pat@ needs
777 -- parentheses under precedence @p@.
778 patNeedsParens :: PprPrec -> Pat p -> Bool
779 patNeedsParens p = go
780 where
781 go (NPlusKPat {}) = p > opPrec
782 go (SplicePat {}) = False
783 go (ConPatIn _ ds) = conPatNeedsParens p ds
784 go cp@(ConPatOut {}) = conPatNeedsParens p (pat_args cp)
785 go (SigPat {}) = p >= sigPrec
786 go (ViewPat {}) = True
787 go (CoPat _ _ p _) = go p
788 go (WildPat {}) = False
789 go (VarPat {}) = False
790 go (LazyPat {}) = False
791 go (BangPat {}) = False
792 go (ParPat {}) = False
793 go (AsPat {}) = False
794 go (TuplePat {}) = False
795 go (SumPat {}) = False
796 go (ListPat {}) = False
797 go (LitPat _ l) = hsLitNeedsParens p l
798 go (NPat _ lol _ _) = hsOverLitNeedsParens p (unLoc lol)
799 go (XPat {}) = True -- conservative default
800
801 -- | @'conPatNeedsParens' p cp@ returns 'True' if the constructor patterns @cp@
802 -- needs parentheses under precedence @p@.
803 conPatNeedsParens :: PprPrec -> HsConDetails a b -> Bool
804 conPatNeedsParens p = go
805 where
806 go (PrefixCon args) = p >= appPrec && not (null args)
807 go (InfixCon {}) = p >= opPrec
808 go (RecCon {}) = False
809
810 -- | @'parenthesizePat' p pat@ checks if @'patNeedsParens' p pat@ is true, and
811 -- if so, surrounds @pat@ with a 'ParPat'. Otherwise, it simply returns @pat@.
812 parenthesizePat :: PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
813 parenthesizePat p lpat@(dL->L loc pat)
814 | patNeedsParens p pat = cL loc (ParPat NoExt lpat)
815 | otherwise = lpat
816
817 {-
818 % Collect all EvVars from all constructor patterns
819 -}
820
821 -- May need to add more cases
822 collectEvVarsPats :: [Pat GhcTc] -> Bag EvVar
823 collectEvVarsPats = unionManyBags . map collectEvVarsPat
824
825 collectEvVarsLPat :: LPat GhcTc -> Bag EvVar
826 collectEvVarsLPat = collectEvVarsPat . unLoc
827
828 collectEvVarsPat :: Pat GhcTc -> Bag EvVar
829 collectEvVarsPat pat =
830 case pat of
831 LazyPat _ p -> collectEvVarsLPat p
832 AsPat _ _ p -> collectEvVarsLPat p
833 ParPat _ p -> collectEvVarsLPat p
834 BangPat _ p -> collectEvVarsLPat p
835 ListPat _ ps -> unionManyBags $ map collectEvVarsLPat ps
836 TuplePat _ ps _ -> unionManyBags $ map collectEvVarsLPat ps
837 SumPat _ p _ _ -> collectEvVarsLPat p
838 ConPatOut {pat_dicts = dicts, pat_args = args}
839 -> unionBags (listToBag dicts)
840 $ unionManyBags
841 $ map collectEvVarsLPat
842 $ hsConPatArgs args
843 SigPat _ p _ -> collectEvVarsLPat p
844 CoPat _ _ p _ -> collectEvVarsPat p
845 ConPatIn _ _ -> panic "foldMapPatBag: ConPatIn"
846 _other_pat -> emptyBag