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