Revert "WIP on combining Step 1 and 3 of 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 pats ty (Just _)) = ListPat 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 (SigPatOut 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 pats ty)
454 = return (idDsWrapper, unLoc parrConPat)
455 where
456 arity = length pats
457 parrConPat = mkPrefixConPat (parrFakeCon arity) pats [ty]
458
459 tidy1 _ (TuplePat pats boxity tys)
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 pat alt arity tys)
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 (L _ lit) mb_neg eq ty)
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 _ (SigPatOut (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 v' p) = tidy1 v (AsPat v' (L l (BangPat p)))
493 tidy_bang_pat v l (CoPat w p t) = tidy1 v (CoPat w (BangPat (L l p)) t)
494
495 -- Discard bang around strict pattern
496 tidy_bang_pat v _ p@(LitPat {}) = tidy1 v p
497 tidy_bang_pat v _ p@(ListPat {}) = tidy1 v p
498 tidy_bang_pat v _ p@(TuplePat {}) = tidy1 v p
499 tidy_bang_pat v _ p@(SumPat {}) = tidy1 v p
500 tidy_bang_pat v _ p@(PArrPat {}) = tidy1 v p
501
502 -- Data/newtype constructors
503 tidy_bang_pat v l p@(ConPatOut { pat_con = L _ (RealDataCon dc)
504 , pat_args = args
505 , pat_arg_tys = arg_tys })
506 -- Newtypes: push bang inwards (Trac #9844)
507 =
508 if isNewTyCon (dataConTyCon dc)
509 then tidy1 v (p { pat_args = push_bang_into_newtype_arg l ty args })
510 else tidy1 v p -- Data types: discard the bang
511 where
512 (ty:_) = dataConInstArgTys dc arg_tys
513
514 -------------------
515 -- Default case, leave the bang there:
516 -- VarPat,
517 -- LazyPat,
518 -- WildPat,
519 -- ViewPat,
520 -- pattern synonyms (ConPatOut with PatSynCon)
521 -- NPat,
522 -- NPlusKPat
523 --
524 -- For LazyPat, remember that it's semantically like a VarPat
525 -- i.e. !(~p) is not like ~p, or p! (Trac #8952)
526 --
527 -- NB: SigPatIn, ConPatIn should not happen
528
529 tidy_bang_pat _ l p = return (idDsWrapper, BangPat (L l p))
530
531 -------------------
532 push_bang_into_newtype_arg :: SrcSpan
533 -> Type -- The type of the argument we are pushing
534 -- onto
535 -> HsConPatDetails GhcTc -> HsConPatDetails GhcTc
536 -- See Note [Bang patterns and newtypes]
537 -- We are transforming !(N p) into (N !p)
538 push_bang_into_newtype_arg l _ty (PrefixCon (arg:args))
539 = ASSERT( null args)
540 PrefixCon [L l (BangPat arg)]
541 push_bang_into_newtype_arg l _ty (RecCon rf)
542 | HsRecFields { rec_flds = L lf fld : flds } <- rf
543 , HsRecField { hsRecFieldArg = arg } <- fld
544 = ASSERT( null flds)
545 RecCon (rf { rec_flds = [L lf (fld { hsRecFieldArg = L l (BangPat arg) })] })
546 push_bang_into_newtype_arg l ty (RecCon rf) -- If a user writes !(T {})
547 | HsRecFields { rec_flds = [] } <- rf
548 = PrefixCon [L l (BangPat (noLoc (WildPat ty)))]
549 push_bang_into_newtype_arg _ _ cd
550 = pprPanic "push_bang_into_newtype_arg" (pprConArgs cd)
551
552 {-
553 Note [Bang patterns and newtypes]
554 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
555 For the pattern !(Just pat) we can discard the bang, because
556 the pattern is strict anyway. But for !(N pat), where
557 newtype NT = N Int
558 we definitely can't discard the bang. Trac #9844.
559
560 So what we do is to push the bang inwards, in the hope that it will
561 get discarded there. So we transform
562 !(N pat) into (N !pat)
563
564 But what if there is nothing to push the bang onto? In at least one instance
565 a user has written !(N {}) which we translate into (N !_). See #13215
566
567
568 \noindent
569 {\bf Previous @matchTwiddled@ stuff:}
570
571 Now we get to the only interesting part; note: there are choices for
572 translation [from Simon's notes]; translation~1:
573 \begin{verbatim}
574 deTwiddle [s,t] e
575 \end{verbatim}
576 returns
577 \begin{verbatim}
578 [ w = e,
579 s = case w of [s,t] -> s
580 t = case w of [s,t] -> t
581 ]
582 \end{verbatim}
583
584 Here \tr{w} is a fresh variable, and the \tr{w}-binding prevents multiple
585 evaluation of \tr{e}. An alternative translation (No.~2):
586 \begin{verbatim}
587 [ w = case e of [s,t] -> (s,t)
588 s = case w of (s,t) -> s
589 t = case w of (s,t) -> t
590 ]
591 \end{verbatim}
592
593 ************************************************************************
594 * *
595 \subsubsection[improved-unmixing]{UNIMPLEMENTED idea for improved unmixing}
596 * *
597 ************************************************************************
598
599 We might be able to optimise unmixing when confronted by
600 only-one-constructor-possible, of which tuples are the most notable
601 examples. Consider:
602 \begin{verbatim}
603 f (a,b,c) ... = ...
604 f d ... (e:f) = ...
605 f (g,h,i) ... = ...
606 f j ... = ...
607 \end{verbatim}
608 This definition would normally be unmixed into four equation blocks,
609 one per equation. But it could be unmixed into just one equation
610 block, because if the one equation matches (on the first column),
611 the others certainly will.
612
613 You have to be careful, though; the example
614 \begin{verbatim}
615 f j ... = ...
616 -------------------
617 f (a,b,c) ... = ...
618 f d ... (e:f) = ...
619 f (g,h,i) ... = ...
620 \end{verbatim}
621 {\em must} be broken into two blocks at the line shown; otherwise, you
622 are forcing unnecessary evaluation. In any case, the top-left pattern
623 always gives the cue. You could then unmix blocks into groups of...
624 \begin{description}
625 \item[all variables:]
626 As it is now.
627 \item[constructors or variables (mixed):]
628 Need to make sure the right names get bound for the variable patterns.
629 \item[literals or variables (mixed):]
630 Presumably just a variant on the constructor case (as it is now).
631 \end{description}
632
633 ************************************************************************
634 * *
635 * matchWrapper: a convenient way to call @match@ *
636 * *
637 ************************************************************************
638 \subsection[matchWrapper]{@matchWrapper@: a convenient interface to @match@}
639
640 Calls to @match@ often involve similar (non-trivial) work; that work
641 is collected here, in @matchWrapper@. This function takes as
642 arguments:
643 \begin{itemize}
644 \item
645 Typechecked @Matches@ (of a function definition, or a case or lambda
646 expression)---the main input;
647 \item
648 An error message to be inserted into any (runtime) pattern-matching
649 failure messages.
650 \end{itemize}
651
652 As results, @matchWrapper@ produces:
653 \begin{itemize}
654 \item
655 A list of variables (@Locals@) that the caller must ``promise'' to
656 bind to appropriate values; and
657 \item
658 a @CoreExpr@, the desugared output (main result).
659 \end{itemize}
660
661 The main actions of @matchWrapper@ include:
662 \begin{enumerate}
663 \item
664 Flatten the @[TypecheckedMatch]@ into a suitable list of
665 @EquationInfo@s.
666 \item
667 Create as many new variables as there are patterns in a pattern-list
668 (in any one of the @EquationInfo@s).
669 \item
670 Create a suitable ``if it fails'' expression---a call to @error@ using
671 the error-string input; the {\em type} of this fail value can be found
672 by examining one of the RHS expressions in one of the @EquationInfo@s.
673 \item
674 Call @match@ with all of this information!
675 \end{enumerate}
676 -}
677
678 matchWrapper :: HsMatchContext Name -- For shadowing warning messages
679 -> Maybe (LHsExpr GhcTc) -- The scrutinee, if we check a case expr
680 -> MatchGroup GhcTc (LHsExpr GhcTc) -- Matches being desugared
681 -> DsM ([Id], CoreExpr) -- Results
682
683 {-
684 There is one small problem with the Lambda Patterns, when somebody
685 writes something similar to:
686 \begin{verbatim}
687 (\ (x:xs) -> ...)
688 \end{verbatim}
689 he/she don't want a warning about incomplete patterns, that is done with
690 the flag @opt_WarnSimplePatterns@.
691 This problem also appears in the:
692 \begin{itemize}
693 \item @do@ patterns, but if the @do@ can fail
694 it creates another equation if the match can fail
695 (see @DsExpr.doDo@ function)
696 \item @let@ patterns, are treated by @matchSimply@
697 List Comprension Patterns, are treated by @matchSimply@ also
698 \end{itemize}
699
700 We can't call @matchSimply@ with Lambda patterns,
701 due to the fact that lambda patterns can have more than
702 one pattern, and match simply only accepts one pattern.
703
704 JJQC 30-Nov-1997
705 -}
706
707 matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches
708 , mg_arg_tys = arg_tys
709 , mg_res_ty = rhs_ty
710 , mg_origin = origin })
711 = do { dflags <- getDynFlags
712 ; locn <- getSrcSpanDs
713
714 ; new_vars <- case matches of
715 [] -> mapM newSysLocalDsNoLP arg_tys
716 (m:_) -> selectMatchVars (map unLoc (hsLMatchPats m))
717
718 ; eqns_info <- mapM (mk_eqn_info new_vars) matches
719
720 -- pattern match check warnings
721 ; unless (isGenerated origin) $
722 when (isAnyPmCheckEnabled dflags (DsMatchContext ctxt locn)) $
723 addTmCsDs (genCaseTmCs1 mb_scr new_vars) $
724 -- See Note [Type and Term Equality Propagation]
725 checkMatches dflags (DsMatchContext ctxt locn) new_vars matches
726
727 ; result_expr <- handleWarnings $
728 matchEquations ctxt new_vars eqns_info rhs_ty
729 ; return (new_vars, result_expr) }
730 where
731 mk_eqn_info vars (L _ (Match { m_pats = pats, m_grhss = grhss }))
732 = do { dflags <- getDynFlags
733 ; let upats = map (unLoc . decideBangHood dflags) pats
734 dicts = toTcTypeBag (collectEvVarsPats upats) -- Only TcTyVars
735 ; tm_cs <- genCaseTmCs2 mb_scr upats vars
736 ; match_result <- addDictsDs dicts $ -- See Note [Type and Term Equality Propagation]
737 addTmCsDs tm_cs $ -- See Note [Type and Term Equality Propagation]
738 dsGRHSs ctxt grhss rhs_ty
739 ; return (EqnInfo { eqn_pats = upats, eqn_rhs = match_result}) }
740
741 handleWarnings = if isGenerated origin
742 then discardWarningsDs
743 else id
744
745
746 matchEquations :: HsMatchContext Name
747 -> [MatchId] -> [EquationInfo] -> Type
748 -> DsM CoreExpr
749 matchEquations ctxt vars eqns_info rhs_ty
750 = do { let error_doc = matchContextErrString ctxt
751
752 ; match_result <- match vars rhs_ty eqns_info
753
754 ; fail_expr <- mkErrorAppDs pAT_ERROR_ID rhs_ty error_doc
755 ; extractMatchResult match_result fail_expr }
756
757 {-
758 ************************************************************************
759 * *
760 \subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern}
761 * *
762 ************************************************************************
763
764 @mkSimpleMatch@ is a wrapper for @match@ which deals with the
765 situation where we want to match a single expression against a single
766 pattern. It returns an expression.
767 -}
768
769 matchSimply :: CoreExpr -- Scrutinee
770 -> HsMatchContext Name -- Match kind
771 -> LPat GhcTc -- Pattern it should match
772 -> CoreExpr -- Return this if it matches
773 -> CoreExpr -- Return this if it doesn't
774 -> DsM CoreExpr
775 -- Do not warn about incomplete patterns; see matchSinglePat comments
776 matchSimply scrut hs_ctx pat result_expr fail_expr = do
777 let
778 match_result = cantFailMatchResult result_expr
779 rhs_ty = exprType fail_expr
780 -- Use exprType of fail_expr, because won't refine in the case of failure!
781 match_result' <- matchSinglePat scrut hs_ctx pat rhs_ty match_result
782 extractMatchResult match_result' fail_expr
783
784 matchSinglePat :: CoreExpr -> HsMatchContext Name -> LPat GhcTc
785 -> Type -> MatchResult -> DsM MatchResult
786 -- matchSinglePat ensures that the scrutinee is a variable
787 -- and then calls match_single_pat_var
788 --
789 -- matchSinglePat does not warn about incomplete patterns
790 -- Used for things like [ e | pat <- stuff ], where
791 -- incomplete patterns are just fine
792
793 matchSinglePat (Var var) ctx pat ty match_result
794 | not (isExternalName (idName var))
795 = match_single_pat_var var ctx pat ty match_result
796
797 matchSinglePat scrut hs_ctx pat ty match_result
798 = do { var <- selectSimpleMatchVarL pat
799 ; match_result' <- match_single_pat_var var hs_ctx pat ty match_result
800 ; return (adjustMatchResult (bindNonRec var scrut) match_result') }
801
802 match_single_pat_var :: Id -- See Note [Match Ids]
803 -> HsMatchContext Name -> LPat GhcTc
804 -> Type -> MatchResult -> DsM MatchResult
805 match_single_pat_var var ctx pat ty match_result
806 = ASSERT2( isInternalName (idName var), ppr var )
807 do { dflags <- getDynFlags
808 ; locn <- getSrcSpanDs
809
810 -- Pattern match check warnings
811 ; checkSingle dflags (DsMatchContext ctx locn) var (unLoc pat)
812
813 ; let eqn_info = EqnInfo { eqn_pats = [unLoc (decideBangHood dflags pat)]
814 , eqn_rhs = match_result }
815 ; match [var] ty [eqn_info] }
816
817
818 {-
819 ************************************************************************
820 * *
821 Pattern classification
822 * *
823 ************************************************************************
824 -}
825
826 data PatGroup
827 = PgAny -- Immediate match: variables, wildcards,
828 -- lazy patterns
829 | PgCon DataCon -- Constructor patterns (incl list, tuple)
830 | PgSyn PatSyn [Type] -- See Note [Pattern synonym groups]
831 | PgLit Literal -- Literal patterns
832 | PgN Rational -- Overloaded numeric literals;
833 -- see Note [Don't use Literal for PgN]
834 | PgOverS FastString -- Overloaded string literals
835 | PgNpK Integer -- n+k patterns
836 | PgBang -- Bang patterns
837 | PgCo Type -- Coercion patterns; the type is the type
838 -- of the pattern *inside*
839 | PgView (LHsExpr GhcTc) -- view pattern (e -> p):
840 -- the LHsExpr is the expression e
841 Type -- the Type is the type of p (equivalently, the result type of e)
842 | PgOverloadedList
843
844 {- Note [Don't use Literal for PgN]
845 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
846 Previously we had, as PatGroup constructors
847
848 | ...
849 | PgN Literal -- Overloaded literals
850 | PgNpK Literal -- n+k patterns
851 | ...
852
853 But Literal is really supposed to represent an *unboxed* literal, like Int#.
854 We were sticking the literal from, say, an overloaded numeric literal pattern
855 into a MachInt constructor. This didn't really make sense; and we now have
856 the invariant that value in a MachInt must be in the range of the target
857 machine's Int# type, and an overloaded literal could meaningfully be larger.
858
859 Solution: For pattern grouping purposes, just store the literal directly in
860 the PgN constructor as a Rational if numeric, and add a PgOverStr constructor
861 for overloaded strings.
862 -}
863
864 groupEquations :: DynFlags -> [EquationInfo] -> [[(PatGroup, EquationInfo)]]
865 -- If the result is of form [g1, g2, g3],
866 -- (a) all the (pg,eq) pairs in g1 have the same pg
867 -- (b) none of the gi are empty
868 -- The ordering of equations is unchanged
869 groupEquations dflags eqns
870 = groupBy same_gp [(patGroup dflags (firstPat eqn), eqn) | eqn <- eqns]
871 where
872 same_gp :: (PatGroup,EquationInfo) -> (PatGroup,EquationInfo) -> Bool
873 (pg1,_) `same_gp` (pg2,_) = pg1 `sameGroup` pg2
874
875 subGroup :: (m -> [[EquationInfo]]) -- Map.elems
876 -> m -- Map.empty
877 -> (a -> m -> Maybe [EquationInfo]) -- Map.lookup
878 -> (a -> [EquationInfo] -> m -> m) -- Map.insert
879 -> [(a, EquationInfo)] -> [[EquationInfo]]
880 -- Input is a particular group. The result sub-groups the
881 -- equations by with particular constructor, literal etc they match.
882 -- Each sub-list in the result has the same PatGroup
883 -- See Note [Take care with pattern order]
884 -- Parameterized by map operations to allow different implementations
885 -- and constraints, eg. types without Ord instance.
886 subGroup elems empty lookup insert group
887 = map reverse $ elems $ foldl accumulate empty group
888 where
889 accumulate pg_map (pg, eqn)
890 = case lookup pg pg_map of
891 Just eqns -> insert pg (eqn:eqns) pg_map
892 Nothing -> insert pg [eqn] pg_map
893 -- pg_map :: Map a [EquationInfo]
894 -- Equations seen so far in reverse order of appearance
895
896 subGroupOrd :: Ord a => [(a, EquationInfo)] -> [[EquationInfo]]
897 subGroupOrd = subGroup Map.elems Map.empty Map.lookup Map.insert
898
899 subGroupUniq :: Uniquable a => [(a, EquationInfo)] -> [[EquationInfo]]
900 subGroupUniq =
901 subGroup eltsUDFM emptyUDFM (flip lookupUDFM) (\k v m -> addToUDFM m k v)
902
903 {- Note [Pattern synonym groups]
904 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
905 If we see
906 f (P a) = e1
907 f (P b) = e2
908 ...
909 where P is a pattern synonym, can we put (P a -> e1) and (P b -> e2) in the
910 same group? We can if P is a constructor, but /not/ if P is a pattern synonym.
911 Consider (Trac #11224)
912 -- readMaybe :: Read a => String -> Maybe a
913 pattern PRead :: Read a => () => a -> String
914 pattern PRead a <- (readMaybe -> Just a)
915
916 f (PRead (x::Int)) = e1
917 f (PRead (y::Bool)) = e2
918 This is all fine: we match the string by trying to read an Int; if that
919 fails we try to read a Bool. But clearly we can't combine the two into a single
920 match.
921
922 Conclusion: we can combine when we invoke PRead /at the same type/. Hence
923 in PgSyn we record the instantiaing types, and use them in sameGroup.
924
925 Note [Take care with pattern order]
926 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
927 In the subGroup function we must be very careful about pattern re-ordering,
928 Consider the patterns [ (True, Nothing), (False, x), (True, y) ]
929 Then in bringing together the patterns for True, we must not
930 swap the Nothing and y!
931 -}
932
933 sameGroup :: PatGroup -> PatGroup -> Bool
934 -- Same group means that a single case expression
935 -- or test will suffice to match both, *and* the order
936 -- of testing within the group is insignificant.
937 sameGroup PgAny PgAny = True
938 sameGroup PgBang PgBang = True
939 sameGroup (PgCon _) (PgCon _) = True -- One case expression
940 sameGroup (PgSyn p1 t1) (PgSyn p2 t2) = p1==p2 && eqTypes t1 t2
941 -- eqTypes: See Note [Pattern synonym groups]
942 sameGroup (PgLit _) (PgLit _) = True -- One case expression
943 sameGroup (PgN l1) (PgN l2) = l1==l2 -- Order is significant
944 sameGroup (PgOverS s1) (PgOverS s2) = s1==s2
945 sameGroup (PgNpK l1) (PgNpK l2) = l1==l2 -- See Note [Grouping overloaded literal patterns]
946 sameGroup (PgCo t1) (PgCo t2) = t1 `eqType` t2
947 -- CoPats are in the same goup only if the type of the
948 -- enclosed pattern is the same. The patterns outside the CoPat
949 -- always have the same type, so this boils down to saying that
950 -- the two coercions are identical.
951 sameGroup (PgView e1 t1) (PgView e2 t2) = viewLExprEq (e1,t1) (e2,t2)
952 -- ViewPats are in the same group iff the expressions
953 -- are "equal"---conservatively, we use syntactic equality
954 sameGroup _ _ = False
955
956 -- An approximation of syntactic equality used for determining when view
957 -- exprs are in the same group.
958 -- This function can always safely return false;
959 -- but doing so will result in the application of the view function being repeated.
960 --
961 -- Currently: compare applications of literals and variables
962 -- and anything else that we can do without involving other
963 -- HsSyn types in the recursion
964 --
965 -- NB we can't assume that the two view expressions have the same type. Consider
966 -- f (e1 -> True) = ...
967 -- f (e2 -> "hi") = ...
968 viewLExprEq :: (LHsExpr GhcTc,Type) -> (LHsExpr GhcTc,Type) -> Bool
969 viewLExprEq (e1,_) (e2,_) = lexp e1 e2
970 where
971 lexp :: LHsExpr GhcTc -> LHsExpr GhcTc -> Bool
972 lexp e e' = exp (unLoc e) (unLoc e')
973
974 ---------
975 exp :: HsExpr GhcTc -> HsExpr GhcTc -> Bool
976 -- real comparison is on HsExpr's
977 -- strip parens
978 exp (HsPar (L _ e)) e' = exp e e'
979 exp e (HsPar (L _ e')) = exp e e'
980 -- because the expressions do not necessarily have the same type,
981 -- we have to compare the wrappers
982 exp (HsWrap h e) (HsWrap h' e') = wrap h h' && exp e e'
983 exp (HsVar i) (HsVar i') = i == i'
984 exp (HsConLikeOut c) (HsConLikeOut c') = c == c'
985 -- the instance for IPName derives using the id, so this works if the
986 -- above does
987 exp (HsIPVar i) (HsIPVar i') = i == i'
988 exp (HsOverLabel l x) (HsOverLabel l' x') = l == l' && x == x'
989 exp (HsOverLit l) (HsOverLit l') =
990 -- Overloaded lits are equal if they have the same type
991 -- and the data is the same.
992 -- this is coarser than comparing the SyntaxExpr's in l and l',
993 -- which resolve the overloading (e.g., fromInteger 1),
994 -- because these expressions get written as a bunch of different variables
995 -- (presumably to improve sharing)
996 eqType (overLitType l) (overLitType l') && l == l'
997 exp (HsApp e1 e2) (HsApp e1' e2') = lexp e1 e1' && lexp e2 e2'
998 -- the fixities have been straightened out by now, so it's safe
999 -- to ignore them?
1000 exp (OpApp l o _ ri) (OpApp l' o' _ ri') =
1001 lexp l l' && lexp o o' && lexp ri ri'
1002 exp (NegApp e n) (NegApp e' n') = lexp e e' && syn_exp n n'
1003 exp (SectionL e1 e2) (SectionL e1' e2') =
1004 lexp e1 e1' && lexp e2 e2'
1005 exp (SectionR e1 e2) (SectionR e1' e2') =
1006 lexp e1 e1' && lexp e2 e2'
1007 exp (ExplicitTuple es1 _) (ExplicitTuple es2 _) =
1008 eq_list tup_arg es1 es2
1009 exp (ExplicitSum _ _ e _) (ExplicitSum _ _ e' _) = lexp e e'
1010 exp (HsIf _ e e1 e2) (HsIf _ e' e1' e2') =
1011 lexp e e' && lexp e1 e1' && lexp e2 e2'
1012
1013 -- Enhancement: could implement equality for more expressions
1014 -- if it seems useful
1015 -- But no need for HsLit, ExplicitList, ExplicitTuple,
1016 -- because they cannot be functions
1017 exp _ _ = False
1018
1019 ---------
1020 syn_exp :: SyntaxExpr GhcTc -> SyntaxExpr GhcTc -> Bool
1021 syn_exp (SyntaxExpr { syn_expr = expr1
1022 , syn_arg_wraps = arg_wraps1
1023 , syn_res_wrap = res_wrap1 })
1024 (SyntaxExpr { syn_expr = expr2
1025 , syn_arg_wraps = arg_wraps2
1026 , syn_res_wrap = res_wrap2 })
1027 = exp expr1 expr2 &&
1028 and (zipWithEqual "viewLExprEq" wrap arg_wraps1 arg_wraps2) &&
1029 wrap res_wrap1 res_wrap2
1030
1031 ---------
1032 tup_arg (L _ (Present e1)) (L _ (Present e2)) = lexp e1 e2
1033 tup_arg (L _ (Missing t1)) (L _ (Missing t2)) = eqType t1 t2
1034 tup_arg _ _ = False
1035
1036 ---------
1037 wrap :: HsWrapper -> HsWrapper -> Bool
1038 -- Conservative, in that it demands that wrappers be
1039 -- syntactically identical and doesn't look under binders
1040 --
1041 -- Coarser notions of equality are possible
1042 -- (e.g., reassociating compositions,
1043 -- equating different ways of writing a coercion)
1044 wrap WpHole WpHole = True
1045 wrap (WpCompose w1 w2) (WpCompose w1' w2') = wrap w1 w1' && wrap w2 w2'
1046 wrap (WpFun w1 w2 _ _) (WpFun w1' w2' _ _) = wrap w1 w1' && wrap w2 w2'
1047 wrap (WpCast co) (WpCast co') = co `eqCoercion` co'
1048 wrap (WpEvApp et1) (WpEvApp et2) = et1 `ev_term` et2
1049 wrap (WpTyApp t) (WpTyApp t') = eqType t t'
1050 -- Enhancement: could implement equality for more wrappers
1051 -- if it seems useful (lams and lets)
1052 wrap _ _ = False
1053
1054 ---------
1055 ev_term :: EvTerm -> EvTerm -> Bool
1056 ev_term (EvId a) (EvId b) = a==b
1057 ev_term (EvCoercion a) (EvCoercion b) = a `eqCoercion` b
1058 ev_term _ _ = False
1059
1060 ---------
1061 eq_list :: (a->a->Bool) -> [a] -> [a] -> Bool
1062 eq_list _ [] [] = True
1063 eq_list _ [] (_:_) = False
1064 eq_list _ (_:_) [] = False
1065 eq_list eq (x:xs) (y:ys) = eq x y && eq_list eq xs ys
1066
1067 patGroup :: DynFlags -> Pat GhcTc -> PatGroup
1068 patGroup _ (ConPatOut { pat_con = L _ con
1069 , pat_arg_tys = tys })
1070 | RealDataCon dcon <- con = PgCon dcon
1071 | PatSynCon psyn <- con = PgSyn psyn tys
1072 patGroup _ (WildPat {}) = PgAny
1073 patGroup _ (BangPat {}) = PgBang
1074 patGroup _ (NPat (L _ OverLit {ol_val=oval}) mb_neg _ _) =
1075 case (oval, isJust mb_neg) of
1076 (HsIntegral i, False) -> PgN (fromInteger (il_value i))
1077 (HsIntegral i, True ) -> PgN (-fromInteger (il_value i))
1078 (HsFractional r, False) -> PgN (fl_value r)
1079 (HsFractional r, True ) -> PgN (-fl_value r)
1080 (HsIsString _ s, _) -> ASSERT(isNothing mb_neg)
1081 PgOverS s
1082 patGroup _ (NPlusKPat _ (L _ OverLit {ol_val=oval}) _ _ _ _) =
1083 case oval of
1084 HsIntegral i -> PgNpK (il_value i)
1085 _ -> pprPanic "patGroup NPlusKPat" (ppr oval)
1086 patGroup _ (CoPat _ p _) = PgCo (hsPatType p) -- Type of innelexp pattern
1087 patGroup _ (ViewPat expr p _) = PgView expr (hsPatType (unLoc p))
1088 patGroup _ (ListPat _ _ (Just _)) = PgOverloadedList
1089 patGroup dflags (LitPat lit) = PgLit (hsLitKey dflags lit)
1090 patGroup _ pat = pprPanic "patGroup" (ppr pat)
1091
1092 {-
1093 Note [Grouping overloaded literal patterns]
1094 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1095 WATCH OUT! Consider
1096
1097 f (n+1) = ...
1098 f (n+2) = ...
1099 f (n+1) = ...
1100
1101 We can't group the first and third together, because the second may match
1102 the same thing as the first. Same goes for *overloaded* literal patterns
1103 f 1 True = ...
1104 f 2 False = ...
1105 f 1 False = ...
1106 If the first arg matches '1' but the second does not match 'True', we
1107 cannot jump to the third equation! Because the same argument might
1108 match '2'!
1109 Hence we don't regard 1 and 2, or (n+1) and (n+2), as part of the same group.
1110 -}