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