921b829fb9c8ef0cb26c937a89d8eed2e361309b
[ghc.git] / compiler / deSugar / Match.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5
6 The @match@ function
7 -}
8
9 {-# LANGUAGE CPP #-}
10 {-# LANGUAGE TypeFamilies #-}
11 {-# LANGUAGE ViewPatterns #-}
12
13 module Match ( match, matchEquations, matchWrapper, matchSimply
14 , matchSinglePat, matchSinglePatVar ) where
15
16 #include "HsVersions.h"
17
18 import GhcPrelude
19
20 import {-#SOURCE#-} DsExpr (dsLExpr, dsSyntaxExpr)
21
22 import BasicTypes ( Origin(..) )
23 import DynFlags
24 import HsSyn
25 import TcHsSyn
26 import TcEvidence
27 import TcRnMonad
28 import Check
29 import CoreSyn
30 import Literal
31 import CoreUtils
32 import MkCore
33 import DsMonad
34 import DsBinds
35 import DsGRHSs
36 import DsUtils
37 import Id
38 import ConLike
39 import DataCon
40 import PatSyn
41 import MatchCon
42 import MatchLit
43 import Type
44 import Coercion ( eqCoercion )
45 import TyCon( isNewTyCon )
46 import TysWiredIn
47 import SrcLoc
48 import Maybes
49 import Util
50 import Name
51 import Outputable
52 import BasicTypes ( isGenerated, il_value, fl_value )
53 import FastString
54 import Unique
55 import UniqDFM
56
57 import Control.Monad( when, unless )
58 import Data.List ( groupBy )
59 import qualified Data.Map as Map
60
61 {-
62 ************************************************************************
63 * *
64 The main matching function
65 * *
66 ************************************************************************
67
68 The function @match@ is basically the same as in the Wadler chapter
69 from "The Implementation of Functional Programming Languages",
70 except it is monadised, to carry around the name supply, info about
71 annotations, etc.
72
73 Notes on @match@'s arguments, assuming $m$ equations and $n$ patterns:
74 \begin{enumerate}
75 \item
76 A list of $n$ variable names, those variables presumably bound to the
77 $n$ expressions being matched against the $n$ patterns. Using the
78 list of $n$ expressions as the first argument showed no benefit and
79 some inelegance.
80
81 \item
82 The second argument, a list giving the ``equation info'' for each of
83 the $m$ equations:
84 \begin{itemize}
85 \item
86 the $n$ patterns for that equation, and
87 \item
88 a list of Core bindings [@(Id, CoreExpr)@ pairs] to be ``stuck on
89 the front'' of the matching code, as in:
90 \begin{verbatim}
91 let <binds>
92 in <matching-code>
93 \end{verbatim}
94 \item
95 and finally: (ToDo: fill in)
96
97 The right way to think about the ``after-match function'' is that it
98 is an embryonic @CoreExpr@ with a ``hole'' at the end for the
99 final ``else expression''.
100 \end{itemize}
101
102 There is a data type, @EquationInfo@, defined in module @DsMonad@.
103
104 An experiment with re-ordering this information about equations (in
105 particular, having the patterns available in column-major order)
106 showed no benefit.
107
108 \item
109 A default expression---what to evaluate if the overall pattern-match
110 fails. This expression will (almost?) always be
111 a measly expression @Var@, unless we know it will only be used once
112 (as we do in @glue_success_exprs@).
113
114 Leaving out this third argument to @match@ (and slamming in lots of
115 @Var "fail"@s) is a positively {\em bad} idea, because it makes it
116 impossible to share the default expressions. (Also, it stands no
117 chance of working in our post-upheaval world of @Locals@.)
118 \end{enumerate}
119
120 Note: @match@ is often called via @matchWrapper@ (end of this module),
121 a function that does much of the house-keeping that goes with a call
122 to @match@.
123
124 It is also worth mentioning the {\em typical} way a block of equations
125 is desugared with @match@. At each stage, it is the first column of
126 patterns that is examined. The steps carried out are roughly:
127 \begin{enumerate}
128 \item
129 Tidy the patterns in column~1 with @tidyEqnInfo@ (this may add
130 bindings to the second component of the equation-info):
131 \item
132 Now {\em unmix} the equations into {\em blocks} [w\/ local function
133 @match_groups@], in which the equations in a block all have the same
134 match group.
135 (see ``the mixture rule'' in SLPJ).
136 \item
137 Call the right match variant on each block of equations; it will do the
138 appropriate thing for each kind of column-1 pattern.
139 \end{enumerate}
140
141 We are a little more paranoid about the ``empty rule'' (SLPJ, p.~87)
142 than the Wadler-chapter code for @match@ (p.~93, first @match@ clause).
143 And gluing the ``success expressions'' together isn't quite so pretty.
144
145 This @match@ uses @tidyEqnInfo@
146 to get `as'- and `twiddle'-patterns out of the way (tidying), before
147 applying ``the mixture rule'' (SLPJ, p.~88) [which really {\em
148 un}mixes the equations], producing a list of equation-info
149 blocks, each block having as its first column patterns compatible with each other.
150
151 Note [Match Ids]
152 ~~~~~~~~~~~~~~~~
153 Most of the matching functions take an Id or [Id] as argument. This Id
154 is the scrutinee(s) of the match. The desugared expression may
155 sometimes use that Id in a local binding or as a case binder. So it
156 should not have an External name; Lint rejects non-top-level binders
157 with External names (#13043).
158
159 See also Note [Localise pattern binders] in DsUtils
160 -}
161
162 type MatchId = Id -- See Note [Match Ids]
163
164 match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with
165 -- ^ See Note [Match Ids]
166 -> Type -- ^ Type of the case expression
167 -> [EquationInfo] -- ^ Info about patterns, etc. (type synonym below)
168 -> DsM MatchResult -- ^ Desugared result!
169
170 match [] ty eqns
171 = ASSERT2( not (null eqns), ppr ty )
172 return (foldr1 combineMatchResults match_results)
173 where
174 match_results = [ ASSERT( null (eqn_pats eqn) )
175 eqn_rhs eqn
176 | eqn <- eqns ]
177
178 match vars@(v:_) ty eqns -- Eqns *can* be empty
179 = ASSERT2( all (isInternalName . idName) vars, ppr vars )
180 do { dflags <- getDynFlags
181 -- Tidy the first pattern, generating
182 -- auxiliary bindings if necessary
183 ; (aux_binds, tidy_eqns) <- mapAndUnzipM (tidyEqnInfo v) eqns
184
185 -- Group the equations and match each group in turn
186 ; let grouped = groupEquations dflags tidy_eqns
187
188 -- print the view patterns that are commoned up to help debug
189 ; whenDOptM Opt_D_dump_view_pattern_commoning (debug grouped)
190
191 ; match_results <- match_groups grouped
192 ; return (adjustMatchResult (foldr (.) id aux_binds) $
193 foldr1 combineMatchResults match_results) }
194 where
195 dropGroup :: [(PatGroup,EquationInfo)] -> [EquationInfo]
196 dropGroup = map snd
197
198 match_groups :: [[(PatGroup,EquationInfo)]] -> DsM [MatchResult]
199 -- Result list of [MatchResult] is always non-empty
200 match_groups [] = matchEmpty v ty
201 match_groups gs = mapM match_group gs
202
203 match_group :: [(PatGroup,EquationInfo)] -> DsM MatchResult
204 match_group [] = panic "match_group"
205 match_group eqns@((group,_) : _)
206 = case group of
207 PgCon {} -> matchConFamily vars ty (subGroupUniq [(c,e) | (PgCon c, e) <- eqns])
208 PgSyn {} -> matchPatSyn vars ty (dropGroup eqns)
209 PgLit {} -> matchLiterals vars ty (subGroupOrd [(l,e) | (PgLit l, e) <- eqns])
210 PgAny -> matchVariables vars ty (dropGroup eqns)
211 PgN {} -> matchNPats vars ty (dropGroup eqns)
212 PgOverS {}-> matchNPats vars ty (dropGroup eqns)
213 PgNpK {} -> matchNPlusKPats vars ty (dropGroup eqns)
214 PgBang -> matchBangs vars ty (dropGroup eqns)
215 PgCo {} -> matchCoercion vars ty (dropGroup eqns)
216 PgView {} -> matchView vars ty (dropGroup eqns)
217 PgOverloadedList -> matchOverloadedList vars ty (dropGroup eqns)
218
219 -- FIXME: we should also warn about view patterns that should be
220 -- commoned up but are not
221
222 -- print some stuff to see what's getting grouped
223 -- use -dppr-debug to see the resolution of overloaded literals
224 debug eqns =
225 let gs = map (\group -> foldr (\ (p,_) -> \acc ->
226 case p of PgView e _ -> e:acc
227 _ -> acc) [] group) eqns
228 maybeWarn [] = return ()
229 maybeWarn l = warnDs NoReason (vcat l)
230 in
231 maybeWarn $ (map (\g -> text "Putting these view expressions into the same case:" <+> (ppr g))
232 (filter (not . null) gs))
233
234 matchEmpty :: MatchId -> Type -> DsM [MatchResult]
235 -- See Note [Empty case expressions]
236 matchEmpty var res_ty
237 = return [MatchResult CanFail mk_seq]
238 where
239 mk_seq fail = return $ mkWildCase (Var var) (idType var) res_ty
240 [(DEFAULT, [], fail)]
241
242 matchVariables :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult
243 -- Real true variables, just like in matchVar, SLPJ p 94
244 -- No binding to do: they'll all be wildcards by now (done in tidy)
245 matchVariables (_:vars) ty eqns = match vars ty (shiftEqns eqns)
246 matchVariables [] _ _ = panic "matchVariables"
247
248 matchBangs :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult
249 matchBangs (var:vars) ty eqns
250 = do { match_result <- match (var:vars) ty $
251 map (decomposeFirstPat getBangPat) eqns
252 ; return (mkEvalMatchResult var ty match_result) }
253 matchBangs [] _ _ = panic "matchBangs"
254
255 matchCoercion :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult
256 -- Apply the coercion to the match variable and then match that
257 matchCoercion (var:vars) ty (eqns@(eqn1:_))
258 = do { let CoPat _ co pat _ = firstPat eqn1
259 ; let pat_ty' = hsPatType pat
260 ; var' <- newUniqueId var pat_ty'
261 ; match_result <- match (var':vars) ty $
262 map (decomposeFirstPat getCoPat) eqns
263 ; core_wrap <- dsHsWrapper co
264 ; let bind = NonRec var' (core_wrap (Var var))
265 ; return (mkCoLetMatchResult bind match_result) }
266 matchCoercion _ _ _ = panic "matchCoercion"
267
268 matchView :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult
269 -- Apply the view function to the match variable and then match that
270 matchView (var:vars) ty (eqns@(eqn1:_))
271 = do { -- we could pass in the expr from the PgView,
272 -- but this needs to extract the pat anyway
273 -- to figure out the type of the fresh variable
274 let ViewPat _ viewExpr (dL->L _ pat) = firstPat eqn1
275 -- do the rest of the compilation
276 ; let pat_ty' = hsPatType pat
277 ; var' <- newUniqueId var pat_ty'
278 ; match_result <- match (var':vars) ty $
279 map (decomposeFirstPat getViewPat) eqns
280 -- compile the view expressions
281 ; viewExpr' <- dsLExpr viewExpr
282 ; return (mkViewMatchResult var'
283 (mkCoreAppDs (text "matchView") viewExpr' (Var var))
284 match_result) }
285 matchView _ _ _ = panic "matchView"
286
287 matchOverloadedList :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult
288 matchOverloadedList (var:vars) ty (eqns@(eqn1:_))
289 -- Since overloaded list patterns are treated as view patterns,
290 -- the code is roughly the same as for matchView
291 = do { let ListPat (ListPatTc elt_ty (Just (_,e))) _ = firstPat eqn1
292 ; var' <- newUniqueId var (mkListTy elt_ty) -- we construct the overall type by hand
293 ; match_result <- match (var':vars) ty $
294 map (decomposeFirstPat getOLPat) eqns -- getOLPat builds the pattern inside as a non-overloaded version of the overloaded list pattern
295 ; e' <- dsSyntaxExpr e [Var var]
296 ; return (mkViewMatchResult var' e' match_result) }
297 matchOverloadedList _ _ _ = panic "matchOverloadedList"
298
299 -- decompose the first pattern and leave the rest alone
300 decomposeFirstPat :: (Pat GhcTc -> Pat GhcTc) -> EquationInfo -> EquationInfo
301 decomposeFirstPat extractpat (eqn@(EqnInfo { eqn_pats = pat : pats }))
302 = eqn { eqn_pats = extractpat pat : pats}
303 decomposeFirstPat _ _ = panic "decomposeFirstPat"
304
305 getCoPat, getBangPat, getViewPat, getOLPat :: Pat GhcTc -> Pat GhcTc
306 getCoPat (CoPat _ _ pat _) = pat
307 getCoPat _ = panic "getCoPat"
308 getBangPat (BangPat _ pat ) = unLoc pat
309 getBangPat _ = panic "getBangPat"
310 getViewPat (ViewPat _ _ pat) = unLoc pat
311 getViewPat _ = panic "getViewPat"
312 getOLPat (ListPat (ListPatTc ty (Just _)) pats)
313 = ListPat (ListPatTc ty Nothing) pats
314 getOLPat _ = panic "getOLPat"
315
316 {-
317 Note [Empty case alternatives]
318 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
319 The list of EquationInfo can be empty, arising from
320 case x of {} or \case {}
321 In that situation we desugar to
322 case x of { _ -> error "pattern match failure" }
323 The *desugarer* isn't certain whether there really should be no
324 alternatives, so it adds a default case, as it always does. A later
325 pass may remove it if it's inaccessible. (See also Note [Empty case
326 alternatives] in CoreSyn.)
327
328 We do *not* desugar simply to
329 error "empty case"
330 or some such, because 'x' might be bound to (error "hello"), in which
331 case we want to see that "hello" exception, not (error "empty case").
332 See also Note [Case elimination: lifted case] in Simplify.
333
334
335 ************************************************************************
336 * *
337 Tidying patterns
338 * *
339 ************************************************************************
340
341 Tidy up the leftmost pattern in an @EquationInfo@, given the variable @v@
342 which will be scrutinised.
343
344 This makes desugaring the pattern match simpler by transforming some of
345 the patterns to simpler forms. (Tuples to Constructor Patterns)
346
347 Among other things in the resulting Pattern:
348 * Variables and irrefutable(lazy) patterns are replaced by Wildcards
349 * As patterns are replaced by the patterns they wrap.
350
351 The bindings created by the above patterns are put into the returned wrapper
352 instead.
353
354 This means a definition of the form:
355 f x = rhs
356 when called with v get's desugared to the equivalent of:
357 let x = v
358 in
359 f _ = rhs
360
361 The same principle holds for as patterns (@) and
362 irrefutable/lazy patterns (~).
363 In the case of irrefutable patterns the irrefutable pattern is pushed into
364 the binding.
365
366 Pattern Constructors which only represent syntactic sugar are converted into
367 their desugared representation.
368 This usually means converting them to Constructor patterns but for some
369 depends on enabled extensions. (Eg OverloadedLists)
370
371 GHC also tries to convert overloaded Literals into regular ones.
372
373 The result of this tidying is that the column of patterns will include
374 only these which can be assigned a PatternGroup (see patGroup).
375
376 -}
377
378 tidyEqnInfo :: Id -> EquationInfo
379 -> DsM (DsWrapper, EquationInfo)
380 -- DsM'd because of internal call to dsLHsBinds
381 -- and mkSelectorBinds.
382 -- "tidy1" does the interesting stuff, looking at
383 -- one pattern and fiddling the list of bindings.
384 --
385 -- POST CONDITION: head pattern in the EqnInfo is
386 -- one of these for which patGroup is defined.
387
388 tidyEqnInfo _ (EqnInfo { eqn_pats = [] })
389 = panic "tidyEqnInfo"
390
391 tidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats, eqn_orig = orig })
392 = do { (wrap, pat') <- tidy1 v orig pat
393 ; return (wrap, eqn { eqn_pats = do pat' : pats }) }
394
395 tidy1 :: Id -- The Id being scrutinised
396 -> Origin -- Was this a pattern the user wrote?
397 -> Pat GhcTc -- The pattern against which it is to be matched
398 -> DsM (DsWrapper, -- Extra bindings to do before the match
399 Pat GhcTc) -- Equivalent pattern
400
401 -------------------------------------------------------
402 -- (pat', mr') = tidy1 v pat mr
403 -- tidies the *outer level only* of pat, giving pat'
404 -- It eliminates many pattern forms (as-patterns, variable patterns,
405 -- list patterns, etc) and returns any created bindings in the wrapper.
406
407 tidy1 v o (ParPat _ pat) = tidy1 v o (unLoc pat)
408 tidy1 v o (SigPat _ pat _) = tidy1 v o (unLoc pat)
409 tidy1 _ _ (WildPat ty) = return (idDsWrapper, WildPat ty)
410 tidy1 v o (BangPat _ (dL->L l p)) = tidy_bang_pat v o l p
411
412 -- case v of { x -> mr[] }
413 -- = case v of { _ -> let x=v in mr[] }
414 tidy1 v _ (VarPat _ (dL->L _ var))
415 = return (wrapBind var v, WildPat (idType var))
416
417 -- case v of { x@p -> mr[] }
418 -- = case v of { p -> let x=v in mr[] }
419 tidy1 v o (AsPat _ (dL->L _ var) pat)
420 = do { (wrap, pat') <- tidy1 v o (unLoc pat)
421 ; return (wrapBind var v . wrap, pat') }
422
423 {- now, here we handle lazy patterns:
424 tidy1 v ~p bs = (v, v1 = case v of p -> v1 :
425 v2 = case v of p -> v2 : ... : bs )
426
427 where the v_i's are the binders in the pattern.
428
429 ToDo: in "v_i = ... -> v_i", are the v_i's really the same thing?
430
431 The case expr for v_i is just: match [v] [(p, [], \ x -> Var v_i)] any_expr
432 -}
433
434 tidy1 v _ (LazyPat _ pat)
435 -- This is a convenient place to check for unlifted types under a lazy pattern.
436 -- Doing this check during type-checking is unsatisfactory because we may
437 -- not fully know the zonked types yet. We sure do here.
438 = do { let unlifted_bndrs = filter (isUnliftedType . idType) (collectPatBinders pat)
439 ; unless (null unlifted_bndrs) $
440 putSrcSpanDs (getLoc pat) $
441 errDs (hang (text "A lazy (~) pattern cannot bind variables of unlifted type." $$
442 text "Unlifted variables:")
443 2 (vcat (map (\id -> ppr id <+> dcolon <+> ppr (idType id))
444 unlifted_bndrs)))
445
446 ; (_,sel_prs) <- mkSelectorBinds [] pat (Var v)
447 ; let sel_binds = [NonRec b rhs | (b,rhs) <- sel_prs]
448 ; return (mkCoreLets sel_binds, WildPat (idType v)) }
449
450 tidy1 _ _ (ListPat (ListPatTc ty Nothing) pats )
451 = return (idDsWrapper, unLoc list_ConPat)
452 where
453 list_ConPat = foldr (\ x y -> mkPrefixConPat consDataCon [x, y] [ty])
454 (mkNilPat ty)
455 pats
456
457 tidy1 _ _ (TuplePat tys pats boxity)
458 = return (idDsWrapper, unLoc tuple_ConPat)
459 where
460 arity = length pats
461 tuple_ConPat = mkPrefixConPat (tupleDataCon boxity arity) pats tys
462
463 tidy1 _ _ (SumPat tys pat alt arity)
464 = return (idDsWrapper, unLoc sum_ConPat)
465 where
466 sum_ConPat = mkPrefixConPat (sumDataCon alt arity) [pat] tys
467
468 -- LitPats: we *might* be able to replace these w/ a simpler form
469 tidy1 _ o (LitPat _ lit)
470 = do { unless (isGenerated o) $
471 warnAboutOverflowedLit lit
472 ; return (idDsWrapper, tidyLitPat lit) }
473
474 -- NPats: we *might* be able to replace these w/ a simpler form
475 tidy1 _ o (NPat ty (dL->L _ lit@OverLit { ol_val = v }) mb_neg eq)
476 = do { unless (isGenerated o) $
477 let lit' | Just _ <- mb_neg = lit{ ol_val = negateOverLitVal v }
478 | otherwise = lit
479 in warnAboutOverflowedOverLit lit'
480 ; return (idDsWrapper, tidyNPat lit mb_neg eq ty) }
481
482 -- NPlusKPat: we may want to warn about the literals
483 tidy1 _ o n@(NPlusKPat _ _ (dL->L _ lit1) lit2 _ _)
484 = do { unless (isGenerated o) $ do
485 warnAboutOverflowedOverLit lit1
486 warnAboutOverflowedOverLit lit2
487 ; return (idDsWrapper, n) }
488
489 -- Everything else goes through unchanged...
490 tidy1 _ _ non_interesting_pat
491 = return (idDsWrapper, non_interesting_pat)
492
493 --------------------
494 tidy_bang_pat :: Id -> Origin -> SrcSpan -> Pat GhcTc
495 -> DsM (DsWrapper, Pat GhcTc)
496
497 -- Discard par/sig under a bang
498 tidy_bang_pat v o _ (ParPat _ (dL->L l p)) = tidy_bang_pat v o l p
499 tidy_bang_pat v o _ (SigPat _ (dL->L l p) _) = tidy_bang_pat v o l p
500
501 -- Push the bang-pattern inwards, in the hope that
502 -- it may disappear next time
503 tidy_bang_pat v o l (AsPat x v' p)
504 = tidy1 v o (AsPat x v' (cL l (BangPat noExtField p)))
505 tidy_bang_pat v o l (CoPat x w p t)
506 = tidy1 v o (CoPat x w (BangPat noExtField (cL l p)) t)
507
508 -- Discard bang around strict pattern
509 tidy_bang_pat v o _ p@(LitPat {}) = tidy1 v o p
510 tidy_bang_pat v o _ p@(ListPat {}) = tidy1 v o p
511 tidy_bang_pat v o _ p@(TuplePat {}) = tidy1 v o p
512 tidy_bang_pat v o _ p@(SumPat {}) = tidy1 v o p
513
514 -- Data/newtype constructors
515 tidy_bang_pat v o l p@(ConPatOut { pat_con = (dL->L _ (RealDataCon dc))
516 , pat_args = args
517 , pat_arg_tys = arg_tys })
518 -- Newtypes: push bang inwards (#9844)
519 =
520 if isNewTyCon (dataConTyCon dc)
521 then tidy1 v o (p { pat_args = push_bang_into_newtype_arg l ty args })
522 else tidy1 v o p -- Data types: discard the bang
523 where
524 (ty:_) = dataConInstArgTys dc arg_tys
525
526 -------------------
527 -- Default case, leave the bang there:
528 -- VarPat,
529 -- LazyPat,
530 -- WildPat,
531 -- ViewPat,
532 -- pattern synonyms (ConPatOut with PatSynCon)
533 -- NPat,
534 -- NPlusKPat
535 --
536 -- For LazyPat, remember that it's semantically like a VarPat
537 -- i.e. !(~p) is not like ~p, or p! (#8952)
538 --
539 -- NB: SigPatIn, ConPatIn should not happen
540
541 tidy_bang_pat _ _ l p = return (idDsWrapper, BangPat noExtField (cL l p))
542
543 -------------------
544 push_bang_into_newtype_arg :: SrcSpan
545 -> Type -- The type of the argument we are pushing
546 -- onto
547 -> HsConPatDetails GhcTc -> HsConPatDetails GhcTc
548 -- See Note [Bang patterns and newtypes]
549 -- We are transforming !(N p) into (N !p)
550 push_bang_into_newtype_arg l _ty (PrefixCon (arg:args))
551 = ASSERT( null args)
552 PrefixCon [cL l (BangPat noExtField arg)]
553 push_bang_into_newtype_arg l _ty (RecCon rf)
554 | HsRecFields { rec_flds = (dL->L lf fld) : flds } <- rf
555 , HsRecField { hsRecFieldArg = arg } <- fld
556 = ASSERT( null flds)
557 RecCon (rf { rec_flds = [cL lf (fld { hsRecFieldArg
558 = cL l (BangPat noExtField arg) })] })
559 push_bang_into_newtype_arg l ty (RecCon rf) -- If a user writes !(T {})
560 | HsRecFields { rec_flds = [] } <- rf
561 = PrefixCon [cL l (BangPat noExtField (noLoc (WildPat ty)))]
562 push_bang_into_newtype_arg _ _ cd
563 = pprPanic "push_bang_into_newtype_arg" (pprConArgs cd)
564
565 {-
566 Note [Bang patterns and newtypes]
567 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
568 For the pattern !(Just pat) we can discard the bang, because
569 the pattern is strict anyway. But for !(N pat), where
570 newtype NT = N Int
571 we definitely can't discard the bang. #9844.
572
573 So what we do is to push the bang inwards, in the hope that it will
574 get discarded there. So we transform
575 !(N pat) into (N !pat)
576
577 But what if there is nothing to push the bang onto? In at least one instance
578 a user has written !(N {}) which we translate into (N !_). See #13215
579
580
581 \noindent
582 {\bf Previous @matchTwiddled@ stuff:}
583
584 Now we get to the only interesting part; note: there are choices for
585 translation [from Simon's notes]; translation~1:
586 \begin{verbatim}
587 deTwiddle [s,t] e
588 \end{verbatim}
589 returns
590 \begin{verbatim}
591 [ w = e,
592 s = case w of [s,t] -> s
593 t = case w of [s,t] -> t
594 ]
595 \end{verbatim}
596
597 Here \tr{w} is a fresh variable, and the \tr{w}-binding prevents multiple
598 evaluation of \tr{e}. An alternative translation (No.~2):
599 \begin{verbatim}
600 [ w = case e of [s,t] -> (s,t)
601 s = case w of (s,t) -> s
602 t = case w of (s,t) -> t
603 ]
604 \end{verbatim}
605
606 ************************************************************************
607 * *
608 \subsubsection[improved-unmixing]{UNIMPLEMENTED idea for improved unmixing}
609 * *
610 ************************************************************************
611
612 We might be able to optimise unmixing when confronted by
613 only-one-constructor-possible, of which tuples are the most notable
614 examples. Consider:
615 \begin{verbatim}
616 f (a,b,c) ... = ...
617 f d ... (e:f) = ...
618 f (g,h,i) ... = ...
619 f j ... = ...
620 \end{verbatim}
621 This definition would normally be unmixed into four equation blocks,
622 one per equation. But it could be unmixed into just one equation
623 block, because if the one equation matches (on the first column),
624 the others certainly will.
625
626 You have to be careful, though; the example
627 \begin{verbatim}
628 f j ... = ...
629 -------------------
630 f (a,b,c) ... = ...
631 f d ... (e:f) = ...
632 f (g,h,i) ... = ...
633 \end{verbatim}
634 {\em must} be broken into two blocks at the line shown; otherwise, you
635 are forcing unnecessary evaluation. In any case, the top-left pattern
636 always gives the cue. You could then unmix blocks into groups of...
637 \begin{description}
638 \item[all variables:]
639 As it is now.
640 \item[constructors or variables (mixed):]
641 Need to make sure the right names get bound for the variable patterns.
642 \item[literals or variables (mixed):]
643 Presumably just a variant on the constructor case (as it is now).
644 \end{description}
645
646 ************************************************************************
647 * *
648 * matchWrapper: a convenient way to call @match@ *
649 * *
650 ************************************************************************
651 \subsection[matchWrapper]{@matchWrapper@: a convenient interface to @match@}
652
653 Calls to @match@ often involve similar (non-trivial) work; that work
654 is collected here, in @matchWrapper@. This function takes as
655 arguments:
656 \begin{itemize}
657 \item
658 Typechecked @Matches@ (of a function definition, or a case or lambda
659 expression)---the main input;
660 \item
661 An error message to be inserted into any (runtime) pattern-matching
662 failure messages.
663 \end{itemize}
664
665 As results, @matchWrapper@ produces:
666 \begin{itemize}
667 \item
668 A list of variables (@Locals@) that the caller must ``promise'' to
669 bind to appropriate values; and
670 \item
671 a @CoreExpr@, the desugared output (main result).
672 \end{itemize}
673
674 The main actions of @matchWrapper@ include:
675 \begin{enumerate}
676 \item
677 Flatten the @[TypecheckedMatch]@ into a suitable list of
678 @EquationInfo@s.
679 \item
680 Create as many new variables as there are patterns in a pattern-list
681 (in any one of the @EquationInfo@s).
682 \item
683 Create a suitable ``if it fails'' expression---a call to @error@ using
684 the error-string input; the {\em type} of this fail value can be found
685 by examining one of the RHS expressions in one of the @EquationInfo@s.
686 \item
687 Call @match@ with all of this information!
688 \end{enumerate}
689 -}
690
691 matchWrapper
692 :: HsMatchContext Name -- ^ For shadowing warning messages
693 -> Maybe (LHsExpr GhcTc) -- ^ Scrutinee, if we check a case expr
694 -> MatchGroup GhcTc (LHsExpr GhcTc) -- ^ Matches being desugared
695 -> DsM ([Id], CoreExpr) -- ^ Results (usually passed to 'match')
696
697 {-
698 There is one small problem with the Lambda Patterns, when somebody
699 writes something similar to:
700 \begin{verbatim}
701 (\ (x:xs) -> ...)
702 \end{verbatim}
703 he/she don't want a warning about incomplete patterns, that is done with
704 the flag @opt_WarnSimplePatterns@.
705 This problem also appears in the:
706 \begin{itemize}
707 \item @do@ patterns, but if the @do@ can fail
708 it creates another equation if the match can fail
709 (see @DsExpr.doDo@ function)
710 \item @let@ patterns, are treated by @matchSimply@
711 List Comprension Patterns, are treated by @matchSimply@ also
712 \end{itemize}
713
714 We can't call @matchSimply@ with Lambda patterns,
715 due to the fact that lambda patterns can have more than
716 one pattern, and match simply only accepts one pattern.
717
718 JJQC 30-Nov-1997
719 -}
720
721 matchWrapper ctxt mb_scr (MG { mg_alts = (dL->L _ matches)
722 , mg_ext = MatchGroupTc arg_tys rhs_ty
723 , mg_origin = origin })
724 = do { dflags <- getDynFlags
725 ; locn <- getSrcSpanDs
726
727 ; new_vars <- case matches of
728 [] -> mapM newSysLocalDsNoLP arg_tys
729 (m:_) -> selectMatchVars (map unLoc (hsLMatchPats m))
730
731 ; eqns_info <- mapM (mk_eqn_info new_vars) matches
732
733 -- pattern match check warnings
734 ; unless (isGenerated origin) $
735 when (isAnyPmCheckEnabled dflags (DsMatchContext ctxt locn)) $
736 addTmCsDs (genCaseTmCs1 mb_scr new_vars) $
737 -- See Note [Type and Term Equality Propagation]
738 checkMatches dflags (DsMatchContext ctxt locn) new_vars matches
739
740 ; result_expr <- handleWarnings $
741 matchEquations ctxt new_vars eqns_info rhs_ty
742 ; return (new_vars, result_expr) }
743 where
744 mk_eqn_info vars (dL->L _ (Match { m_pats = pats, m_grhss = grhss }))
745 = do { dflags <- getDynFlags
746 ; let upats = map (unLoc . decideBangHood dflags) pats
747 dicts = collectEvVarsPats upats
748 ; tm_cs <- genCaseTmCs2 mb_scr upats vars
749 ; match_result <- addDictsDs dicts $ -- See Note [Type and Term Equality Propagation]
750 addTmCsDs tm_cs $ -- See Note [Type and Term Equality Propagation]
751 dsGRHSs ctxt grhss rhs_ty
752 ; return (EqnInfo { eqn_pats = upats
753 , eqn_orig = FromSource
754 , eqn_rhs = match_result }) }
755 mk_eqn_info _ (dL->L _ (XMatch nec)) = noExtCon nec
756 mk_eqn_info _ _ = panic "mk_eqn_info: Impossible Match" -- due to #15884
757
758 handleWarnings = if isGenerated origin
759 then discardWarningsDs
760 else id
761 matchWrapper _ _ (XMatchGroup nec) = noExtCon nec
762
763 matchEquations :: HsMatchContext Name
764 -> [MatchId] -> [EquationInfo] -> Type
765 -> DsM CoreExpr
766 matchEquations ctxt vars eqns_info rhs_ty
767 = do { let error_doc = matchContextErrString ctxt
768
769 ; match_result <- match vars rhs_ty eqns_info
770
771 ; fail_expr <- mkErrorAppDs pAT_ERROR_ID rhs_ty error_doc
772 ; extractMatchResult match_result fail_expr }
773
774 {-
775 ************************************************************************
776 * *
777 \subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern}
778 * *
779 ************************************************************************
780
781 @mkSimpleMatch@ is a wrapper for @match@ which deals with the
782 situation where we want to match a single expression against a single
783 pattern. It returns an expression.
784 -}
785
786 matchSimply :: CoreExpr -- ^ Scrutinee
787 -> HsMatchContext Name -- ^ Match kind
788 -> LPat GhcTc -- ^ Pattern it should match
789 -> CoreExpr -- ^ Return this if it matches
790 -> CoreExpr -- ^ Return this if it doesn't
791 -> DsM CoreExpr
792 -- Do not warn about incomplete patterns; see matchSinglePat comments
793 matchSimply scrut hs_ctx pat result_expr fail_expr = do
794 let
795 match_result = cantFailMatchResult result_expr
796 rhs_ty = exprType fail_expr
797 -- Use exprType of fail_expr, because won't refine in the case of failure!
798 match_result' <- matchSinglePat scrut hs_ctx pat rhs_ty match_result
799 extractMatchResult match_result' fail_expr
800
801 matchSinglePat :: CoreExpr -> HsMatchContext Name -> LPat GhcTc
802 -> Type -> MatchResult -> DsM MatchResult
803 -- matchSinglePat ensures that the scrutinee is a variable
804 -- and then calls matchSinglePatVar
805 --
806 -- matchSinglePat does not warn about incomplete patterns
807 -- Used for things like [ e | pat <- stuff ], where
808 -- incomplete patterns are just fine
809
810 matchSinglePat (Var var) ctx pat ty match_result
811 | not (isExternalName (idName var))
812 = matchSinglePatVar var ctx pat ty match_result
813
814 matchSinglePat scrut hs_ctx pat ty match_result
815 = do { var <- selectSimpleMatchVarL pat
816 ; match_result' <- matchSinglePatVar var hs_ctx pat ty match_result
817 ; return (adjustMatchResult (bindNonRec var scrut) match_result') }
818
819 matchSinglePatVar :: Id -- See Note [Match Ids]
820 -> HsMatchContext Name -> LPat GhcTc
821 -> Type -> MatchResult -> DsM MatchResult
822 matchSinglePatVar var ctx pat ty match_result
823 = ASSERT2( isInternalName (idName var), ppr var )
824 do { dflags <- getDynFlags
825 ; locn <- getSrcSpanDs
826
827 -- Pattern match check warnings
828 ; checkSingle dflags (DsMatchContext ctx locn) var (unLoc pat)
829
830 ; let eqn_info = EqnInfo { eqn_pats = [unLoc (decideBangHood dflags pat)]
831 , eqn_orig = FromSource
832 , eqn_rhs = match_result }
833 ; match [var] ty [eqn_info] }
834
835
836 {-
837 ************************************************************************
838 * *
839 Pattern classification
840 * *
841 ************************************************************************
842 -}
843
844 data PatGroup
845 = PgAny -- Immediate match: variables, wildcards,
846 -- lazy patterns
847 | PgCon DataCon -- Constructor patterns (incl list, tuple)
848 | PgSyn PatSyn [Type] -- See Note [Pattern synonym groups]
849 | PgLit Literal -- Literal patterns
850 | PgN Rational -- Overloaded numeric literals;
851 -- see Note [Don't use Literal for PgN]
852 | PgOverS FastString -- Overloaded string literals
853 | PgNpK Integer -- n+k patterns
854 | PgBang -- Bang patterns
855 | PgCo Type -- Coercion patterns; the type is the type
856 -- of the pattern *inside*
857 | PgView (LHsExpr GhcTc) -- view pattern (e -> p):
858 -- the LHsExpr is the expression e
859 Type -- the Type is the type of p (equivalently, the result type of e)
860 | PgOverloadedList
861
862 {- Note [Don't use Literal for PgN]
863 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
864 Previously we had, as PatGroup constructors
865
866 | ...
867 | PgN Literal -- Overloaded literals
868 | PgNpK Literal -- n+k patterns
869 | ...
870
871 But Literal is really supposed to represent an *unboxed* literal, like Int#.
872 We were sticking the literal from, say, an overloaded numeric literal pattern
873 into a LitInt constructor. This didn't really make sense; and we now have
874 the invariant that value in a LitInt must be in the range of the target
875 machine's Int# type, and an overloaded literal could meaningfully be larger.
876
877 Solution: For pattern grouping purposes, just store the literal directly in
878 the PgN constructor as a Rational if numeric, and add a PgOverStr constructor
879 for overloaded strings.
880 -}
881
882 groupEquations :: DynFlags -> [EquationInfo] -> [[(PatGroup, EquationInfo)]]
883 -- If the result is of form [g1, g2, g3],
884 -- (a) all the (pg,eq) pairs in g1 have the same pg
885 -- (b) none of the gi are empty
886 -- The ordering of equations is unchanged
887 groupEquations dflags eqns
888 = groupBy same_gp [(patGroup dflags (firstPat eqn), eqn) | eqn <- eqns]
889 where
890 same_gp :: (PatGroup,EquationInfo) -> (PatGroup,EquationInfo) -> Bool
891 (pg1,_) `same_gp` (pg2,_) = pg1 `sameGroup` pg2
892
893 subGroup :: (m -> [[EquationInfo]]) -- Map.elems
894 -> m -- Map.empty
895 -> (a -> m -> Maybe [EquationInfo]) -- Map.lookup
896 -> (a -> [EquationInfo] -> m -> m) -- Map.insert
897 -> [(a, EquationInfo)] -> [[EquationInfo]]
898 -- Input is a particular group. The result sub-groups the
899 -- equations by with particular constructor, literal etc they match.
900 -- Each sub-list in the result has the same PatGroup
901 -- See Note [Take care with pattern order]
902 -- Parameterized by map operations to allow different implementations
903 -- and constraints, eg. types without Ord instance.
904 subGroup elems empty lookup insert group
905 = map reverse $ elems $ foldl' accumulate empty group
906 where
907 accumulate pg_map (pg, eqn)
908 = case lookup pg pg_map of
909 Just eqns -> insert pg (eqn:eqns) pg_map
910 Nothing -> insert pg [eqn] pg_map
911 -- pg_map :: Map a [EquationInfo]
912 -- Equations seen so far in reverse order of appearance
913
914 subGroupOrd :: Ord a => [(a, EquationInfo)] -> [[EquationInfo]]
915 subGroupOrd = subGroup Map.elems Map.empty Map.lookup Map.insert
916
917 subGroupUniq :: Uniquable a => [(a, EquationInfo)] -> [[EquationInfo]]
918 subGroupUniq =
919 subGroup eltsUDFM emptyUDFM (flip lookupUDFM) (\k v m -> addToUDFM m k v)
920
921 {- Note [Pattern synonym groups]
922 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
923 If we see
924 f (P a) = e1
925 f (P b) = e2
926 ...
927 where P is a pattern synonym, can we put (P a -> e1) and (P b -> e2) in the
928 same group? We can if P is a constructor, but /not/ if P is a pattern synonym.
929 Consider (#11224)
930 -- readMaybe :: Read a => String -> Maybe a
931 pattern PRead :: Read a => () => a -> String
932 pattern PRead a <- (readMaybe -> Just a)
933
934 f (PRead (x::Int)) = e1
935 f (PRead (y::Bool)) = e2
936 This is all fine: we match the string by trying to read an Int; if that
937 fails we try to read a Bool. But clearly we can't combine the two into a single
938 match.
939
940 Conclusion: we can combine when we invoke PRead /at the same type/. Hence
941 in PgSyn we record the instantiaing types, and use them in sameGroup.
942
943 Note [Take care with pattern order]
944 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
945 In the subGroup function we must be very careful about pattern re-ordering,
946 Consider the patterns [ (True, Nothing), (False, x), (True, y) ]
947 Then in bringing together the patterns for True, we must not
948 swap the Nothing and y!
949 -}
950
951 sameGroup :: PatGroup -> PatGroup -> Bool
952 -- Same group means that a single case expression
953 -- or test will suffice to match both, *and* the order
954 -- of testing within the group is insignificant.
955 sameGroup PgAny PgAny = True
956 sameGroup PgBang PgBang = True
957 sameGroup (PgCon _) (PgCon _) = True -- One case expression
958 sameGroup (PgSyn p1 t1) (PgSyn p2 t2) = p1==p2 && eqTypes t1 t2
959 -- eqTypes: See Note [Pattern synonym groups]
960 sameGroup (PgLit _) (PgLit _) = True -- One case expression
961 sameGroup (PgN l1) (PgN l2) = l1==l2 -- Order is significant
962 sameGroup (PgOverS s1) (PgOverS s2) = s1==s2
963 sameGroup (PgNpK l1) (PgNpK l2) = l1==l2 -- See Note [Grouping overloaded literal patterns]
964 sameGroup (PgCo t1) (PgCo t2) = t1 `eqType` t2
965 -- CoPats are in the same goup only if the type of the
966 -- enclosed pattern is the same. The patterns outside the CoPat
967 -- always have the same type, so this boils down to saying that
968 -- the two coercions are identical.
969 sameGroup (PgView e1 t1) (PgView e2 t2) = viewLExprEq (e1,t1) (e2,t2)
970 -- ViewPats are in the same group iff the expressions
971 -- are "equal"---conservatively, we use syntactic equality
972 sameGroup _ _ = False
973
974 -- An approximation of syntactic equality used for determining when view
975 -- exprs are in the same group.
976 -- This function can always safely return false;
977 -- but doing so will result in the application of the view function being repeated.
978 --
979 -- Currently: compare applications of literals and variables
980 -- and anything else that we can do without involving other
981 -- HsSyn types in the recursion
982 --
983 -- NB we can't assume that the two view expressions have the same type. Consider
984 -- f (e1 -> True) = ...
985 -- f (e2 -> "hi") = ...
986 viewLExprEq :: (LHsExpr GhcTc,Type) -> (LHsExpr GhcTc,Type) -> Bool
987 viewLExprEq (e1,_) (e2,_) = lexp e1 e2
988 where
989 lexp :: LHsExpr GhcTc -> LHsExpr GhcTc -> Bool
990 lexp e e' = exp (unLoc e) (unLoc e')
991
992 ---------
993 exp :: HsExpr GhcTc -> HsExpr GhcTc -> Bool
994 -- real comparison is on HsExpr's
995 -- strip parens
996 exp (HsPar _ (dL->L _ e)) e' = exp e e'
997 exp e (HsPar _ (dL->L _ e')) = exp e e'
998 -- because the expressions do not necessarily have the same type,
999 -- we have to compare the wrappers
1000 exp (HsWrap _ h e) (HsWrap _ h' e') = wrap h h' && exp e e'
1001 exp (HsVar _ i) (HsVar _ i') = i == i'
1002 exp (HsConLikeOut _ c) (HsConLikeOut _ c') = c == c'
1003 -- the instance for IPName derives using the id, so this works if the
1004 -- above does
1005 exp (HsIPVar _ i) (HsIPVar _ i') = i == i'
1006 exp (HsOverLabel _ l x) (HsOverLabel _ l' x') = l == l' && x == x'
1007 exp (HsOverLit _ l) (HsOverLit _ l') =
1008 -- Overloaded lits are equal if they have the same type
1009 -- and the data is the same.
1010 -- this is coarser than comparing the SyntaxExpr's in l and l',
1011 -- which resolve the overloading (e.g., fromInteger 1),
1012 -- because these expressions get written as a bunch of different variables
1013 -- (presumably to improve sharing)
1014 eqType (overLitType l) (overLitType l') && l == l'
1015 exp (HsApp _ e1 e2) (HsApp _ e1' e2') = lexp e1 e1' && lexp e2 e2'
1016 -- the fixities have been straightened out by now, so it's safe
1017 -- to ignore them?
1018 exp (OpApp _ l o ri) (OpApp _ l' o' ri') =
1019 lexp l l' && lexp o o' && lexp ri ri'
1020 exp (NegApp _ e n) (NegApp _ e' n') = lexp e e' && syn_exp n n'
1021 exp (SectionL _ e1 e2) (SectionL _ e1' e2') =
1022 lexp e1 e1' && lexp e2 e2'
1023 exp (SectionR _ e1 e2) (SectionR _ e1' e2') =
1024 lexp e1 e1' && lexp e2 e2'
1025 exp (ExplicitTuple _ es1 _) (ExplicitTuple _ es2 _) =
1026 eq_list tup_arg es1 es2
1027 exp (ExplicitSum _ _ _ e) (ExplicitSum _ _ _ e') = lexp e e'
1028 exp (HsIf _ _ e e1 e2) (HsIf _ _ e' e1' e2') =
1029 lexp e e' && lexp e1 e1' && lexp e2 e2'
1030
1031 -- Enhancement: could implement equality for more expressions
1032 -- if it seems useful
1033 -- But no need for HsLit, ExplicitList, ExplicitTuple,
1034 -- because they cannot be functions
1035 exp _ _ = False
1036
1037 ---------
1038 syn_exp :: SyntaxExpr GhcTc -> SyntaxExpr GhcTc -> Bool
1039 syn_exp (SyntaxExpr { syn_expr = expr1
1040 , syn_arg_wraps = arg_wraps1
1041 , syn_res_wrap = res_wrap1 })
1042 (SyntaxExpr { syn_expr = expr2
1043 , syn_arg_wraps = arg_wraps2
1044 , syn_res_wrap = res_wrap2 })
1045 = exp expr1 expr2 &&
1046 and (zipWithEqual "viewLExprEq" wrap arg_wraps1 arg_wraps2) &&
1047 wrap res_wrap1 res_wrap2
1048
1049 ---------
1050 tup_arg (dL->L _ (Present _ e1)) (dL->L _ (Present _ e2)) = lexp e1 e2
1051 tup_arg (dL->L _ (Missing t1)) (dL->L _ (Missing t2)) = eqType t1 t2
1052 tup_arg _ _ = False
1053
1054 ---------
1055 wrap :: HsWrapper -> HsWrapper -> Bool
1056 -- Conservative, in that it demands that wrappers be
1057 -- syntactically identical and doesn't look under binders
1058 --
1059 -- Coarser notions of equality are possible
1060 -- (e.g., reassociating compositions,
1061 -- equating different ways of writing a coercion)
1062 wrap WpHole WpHole = True
1063 wrap (WpCompose w1 w2) (WpCompose w1' w2') = wrap w1 w1' && wrap w2 w2'
1064 wrap (WpFun w1 w2 _ _) (WpFun w1' w2' _ _) = wrap w1 w1' && wrap w2 w2'
1065 wrap (WpCast co) (WpCast co') = co `eqCoercion` co'
1066 wrap (WpEvApp et1) (WpEvApp et2) = et1 `ev_term` et2
1067 wrap (WpTyApp t) (WpTyApp t') = eqType t t'
1068 -- Enhancement: could implement equality for more wrappers
1069 -- if it seems useful (lams and lets)
1070 wrap _ _ = False
1071
1072 ---------
1073 ev_term :: EvTerm -> EvTerm -> Bool
1074 ev_term (EvExpr (Var a)) (EvExpr (Var b)) = a==b
1075 ev_term (EvExpr (Coercion a)) (EvExpr (Coercion b)) = a `eqCoercion` b
1076 ev_term _ _ = False
1077
1078 ---------
1079 eq_list :: (a->a->Bool) -> [a] -> [a] -> Bool
1080 eq_list _ [] [] = True
1081 eq_list _ [] (_:_) = False
1082 eq_list _ (_:_) [] = False
1083 eq_list eq (x:xs) (y:ys) = eq x y && eq_list eq xs ys
1084
1085 patGroup :: DynFlags -> Pat GhcTc -> PatGroup
1086 patGroup _ (ConPatOut { pat_con = (dL->L _ con)
1087 , pat_arg_tys = tys })
1088 | RealDataCon dcon <- con = PgCon dcon
1089 | PatSynCon psyn <- con = PgSyn psyn tys
1090 patGroup _ (WildPat {}) = PgAny
1091 patGroup _ (BangPat {}) = PgBang
1092 patGroup _ (NPat _ (dL->L _ (OverLit {ol_val=oval})) mb_neg _) =
1093 case (oval, isJust mb_neg) of
1094 (HsIntegral i, False) -> PgN (fromInteger (il_value i))
1095 (HsIntegral i, True ) -> PgN (-fromInteger (il_value i))
1096 (HsFractional r, False) -> PgN (fl_value r)
1097 (HsFractional r, True ) -> PgN (-fl_value r)
1098 (HsIsString _ s, _) -> ASSERT(isNothing mb_neg)
1099 PgOverS s
1100 patGroup _ (NPlusKPat _ _ (dL->L _ (OverLit {ol_val=oval})) _ _ _) =
1101 case oval of
1102 HsIntegral i -> PgNpK (il_value i)
1103 _ -> pprPanic "patGroup NPlusKPat" (ppr oval)
1104 patGroup _ (CoPat _ _ p _) = PgCo (hsPatType p)
1105 -- Type of innelexp pattern
1106 patGroup _ (ViewPat _ expr p) = PgView expr (hsPatType (unLoc p))
1107 patGroup _ (ListPat (ListPatTc _ (Just _)) _) = PgOverloadedList
1108 patGroup dflags (LitPat _ lit) = PgLit (hsLitKey dflags lit)
1109 patGroup _ pat = pprPanic "patGroup" (ppr pat)
1110
1111 {-
1112 Note [Grouping overloaded literal patterns]
1113 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1114 WATCH OUT! Consider
1115
1116 f (n+1) = ...
1117 f (n+2) = ...
1118 f (n+1) = ...
1119
1120 We can't group the first and third together, because the second may match
1121 the same thing as the first. Same goes for *overloaded* literal patterns
1122 f 1 True = ...
1123 f 2 False = ...
1124 f 1 False = ...
1125 If the first arg matches '1' but the second does not match 'True', we
1126 cannot jump to the third equation! Because the same argument might
1127 match '2'!
1128 Hence we don't regard 1 and 2, or (n+1) and (n+2), as part of the same group.
1129 -}