Add a missing prime, to fix desugaring of CoPats
[ghc.git] / compiler / deSugar / Match.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4 \section[Main_match]{The @match@ function}
5
6 \begin{code}
7 module Match ( match, matchEquations, matchWrapper, matchSimply, matchSinglePat ) where
8
9 #include "HsVersions.h"
10
11 import DynFlags ( DynFlag(..), dopt )
12 import HsSyn            
13 import TcHsSyn          ( mkVanillaTuplePat, hsPatType )
14 import Check            ( check, ExhaustivePat )
15 import CoreSyn
16 import Literal          ( Literal )
17 import CoreUtils        ( bindNonRec, exprType )
18 import DsMonad
19 import DsBinds          ( dsLHsBinds, dsCoercion )
20 import DsGRHSs          ( dsGRHSs )
21 import DsUtils
22 import Id               ( idName, idType, Id )
23 import DataCon          ( DataCon )
24 import MatchCon         ( matchConFamily )
25 import MatchLit         ( matchLiterals, matchNPlusKPats, matchNPats, 
26                           tidyLitPat, tidyNPat, hsLitKey, hsOverLitKey )
27 import PrelInfo         ( pAT_ERROR_ID )
28 import TcType           ( Type )
29 import Type             ( splitFunTysN, coreEqType )
30 import TysWiredIn       ( consDataCon, mkListTy, unitTy,
31                           tupleCon, parrFakeCon, mkPArrTy )
32 import BasicTypes       ( Boxity(..) )
33 import ListSetOps       ( equivClasses, runs )
34 import SrcLoc           ( unLoc, Located(..) )
35 import Maybes           ( isJust )
36 import Util             ( lengthExceeds, notNull )
37 import Name             ( Name )
38 import Outputable
39 \end{code}
40
41 This function is a wrapper of @match@, it must be called from all the parts where 
42 it was called match, but only substitutes the firs call, ....
43 if the associated flags are declared, warnings will be issued.
44 It can not be called matchWrapper because this name already exists :-(
45
46 JJCQ 30-Nov-1997
47
48 \begin{code}
49 matchCheck ::  DsMatchContext
50             -> [Id]             -- Vars rep'ing the exprs we're matching with
51             -> Type             -- Type of the case expression
52             -> [EquationInfo]   -- Info about patterns, etc. (type synonym below)
53             -> DsM MatchResult  -- Desugared result!
54
55 matchCheck ctx vars ty qs
56    = getDOptsDs                                 `thenDs` \ dflags ->
57      matchCheck_really dflags ctx vars ty qs
58
59 matchCheck_really dflags ctx vars ty qs
60   | incomplete && shadow = 
61       dsShadowWarn ctx eqns_shadow              `thenDs`   \ () ->
62       dsIncompleteWarn ctx pats                 `thenDs`   \ () ->
63       match vars ty qs
64   | incomplete            = 
65       dsIncompleteWarn ctx pats                 `thenDs`   \ () ->
66       match vars ty qs
67   | shadow                = 
68       dsShadowWarn ctx eqns_shadow              `thenDs`   \ () ->
69       match vars ty qs
70   | otherwise             =
71       match vars ty qs
72   where (pats, eqns_shadow) = check qs
73         incomplete    = want_incomplete && (notNull pats)
74         want_incomplete = case ctx of
75                               DsMatchContext RecUpd _ ->
76                                   dopt Opt_WarnIncompletePatternsRecUpd dflags
77                               _ ->
78                                   dopt Opt_WarnIncompletePatterns       dflags
79         shadow        = dopt Opt_WarnOverlappingPatterns dflags
80                         && not (null eqns_shadow)
81 \end{code}
82
83 This variable shows the maximum number of lines of output generated for warnings.
84 It will limit the number of patterns/equations displayed to@ maximum_output@.
85
86 (ToDo: add command-line option?)
87
88 \begin{code}
89 maximum_output = 4
90 \end{code}
91
92 The next two functions create the warning message.
93
94 \begin{code}
95 dsShadowWarn :: DsMatchContext -> [EquationInfo] -> DsM ()
96 dsShadowWarn ctx@(DsMatchContext kind loc) qs
97   = putSrcSpanDs loc (warnDs warn)
98   where
99     warn | qs `lengthExceeds` maximum_output
100          = pp_context ctx (ptext SLIT("are overlapped"))
101                       (\ f -> vcat (map (ppr_eqn f kind) (take maximum_output qs)) $$
102                       ptext SLIT("..."))
103          | otherwise
104          = pp_context ctx (ptext SLIT("are overlapped"))
105                       (\ f -> vcat $ map (ppr_eqn f kind) qs)
106
107
108 dsIncompleteWarn :: DsMatchContext -> [ExhaustivePat] -> DsM ()
109 dsIncompleteWarn ctx@(DsMatchContext kind loc) pats 
110   = putSrcSpanDs loc (warnDs warn)
111         where
112           warn = pp_context ctx (ptext SLIT("are non-exhaustive"))
113                             (\f -> hang (ptext SLIT("Patterns not matched:"))
114                                    4 ((vcat $ map (ppr_incomplete_pats kind)
115                                                   (take maximum_output pats))
116                                       $$ dots))
117
118           dots | pats `lengthExceeds` maximum_output = ptext SLIT("...")
119                | otherwise                           = empty
120
121 pp_context (DsMatchContext kind _loc) msg rest_of_msg_fun
122   = vcat [ptext SLIT("Pattern match(es)") <+> msg,
123           sep [ptext SLIT("In") <+> ppr_match <> char ':', nest 4 (rest_of_msg_fun pref)]]
124   where
125     (ppr_match, pref)
126         = case kind of
127              FunRhs fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp)
128              other      -> (pprMatchContext kind, \ pp -> pp)
129
130 ppr_pats pats = sep (map ppr pats)
131
132 ppr_shadow_pats kind pats
133   = sep [ppr_pats pats, matchSeparator kind, ptext SLIT("...")]
134     
135 ppr_incomplete_pats kind (pats,[]) = ppr_pats pats
136 ppr_incomplete_pats kind (pats,constraints) = 
137                          sep [ppr_pats pats, ptext SLIT("with"), 
138                               sep (map ppr_constraint constraints)]
139     
140
141 ppr_constraint (var,pats) = sep [ppr var, ptext SLIT("`notElem`"), ppr pats]
142
143 ppr_eqn prefixF kind eqn = prefixF (ppr_shadow_pats kind (eqn_pats eqn))
144 \end{code}
145
146
147 %************************************************************************
148 %*                                                                      *
149                 The main matching function
150 %*                                                                      *
151 %************************************************************************
152
153 The function @match@ is basically the same as in the Wadler chapter,
154 except it is monadised, to carry around the name supply, info about
155 annotations, etc.
156
157 Notes on @match@'s arguments, assuming $m$ equations and $n$ patterns:
158 \begin{enumerate}
159 \item
160 A list of $n$ variable names, those variables presumably bound to the
161 $n$ expressions being matched against the $n$ patterns.  Using the
162 list of $n$ expressions as the first argument showed no benefit and
163 some inelegance.
164
165 \item
166 The second argument, a list giving the ``equation info'' for each of
167 the $m$ equations:
168 \begin{itemize}
169 \item
170 the $n$ patterns for that equation, and
171 \item
172 a list of Core bindings [@(Id, CoreExpr)@ pairs] to be ``stuck on
173 the front'' of the matching code, as in:
174 \begin{verbatim}
175 let <binds>
176 in  <matching-code>
177 \end{verbatim}
178 \item
179 and finally: (ToDo: fill in)
180
181 The right way to think about the ``after-match function'' is that it
182 is an embryonic @CoreExpr@ with a ``hole'' at the end for the
183 final ``else expression''.
184 \end{itemize}
185
186 There is a type synonym, @EquationInfo@, defined in module @DsUtils@.
187
188 An experiment with re-ordering this information about equations (in
189 particular, having the patterns available in column-major order)
190 showed no benefit.
191
192 \item
193 A default expression---what to evaluate if the overall pattern-match
194 fails.  This expression will (almost?) always be
195 a measly expression @Var@, unless we know it will only be used once
196 (as we do in @glue_success_exprs@).
197
198 Leaving out this third argument to @match@ (and slamming in lots of
199 @Var "fail"@s) is a positively {\em bad} idea, because it makes it
200 impossible to share the default expressions.  (Also, it stands no
201 chance of working in our post-upheaval world of @Locals@.)
202 \end{enumerate}
203
204 Note: @match@ is often called via @matchWrapper@ (end of this module),
205 a function that does much of the house-keeping that goes with a call
206 to @match@.
207
208 It is also worth mentioning the {\em typical} way a block of equations
209 is desugared with @match@.  At each stage, it is the first column of
210 patterns that is examined.  The steps carried out are roughly:
211 \begin{enumerate}
212 \item
213 Tidy the patterns in column~1 with @tidyEqnInfo@ (this may add
214 bindings to the second component of the equation-info):
215 \begin{itemize}
216 \item
217 Remove the `as' patterns from column~1.
218 \item
219 Make all constructor patterns in column~1 into @ConPats@, notably
220 @ListPats@ and @TuplePats@.
221 \item
222 Handle any irrefutable (or ``twiddle'') @LazyPats@.
223 \end{itemize}
224 \item
225 Now {\em unmix} the equations into {\em blocks} [w/ local function
226 @unmix_eqns@], in which the equations in a block all have variable
227 patterns in column~1, or they all have constructor patterns in ...
228 (see ``the mixture rule'' in SLPJ).
229 \item
230 Call @matchEqnBlock@ on each block of equations; it will do the
231 appropriate thing for each kind of column-1 pattern, usually ending up
232 in a recursive call to @match@.
233 \end{enumerate}
234
235 We are a little more paranoid about the ``empty rule'' (SLPJ, p.~87)
236 than the Wadler-chapter code for @match@ (p.~93, first @match@ clause).
237 And gluing the ``success expressions'' together isn't quite so pretty.
238
239 This (more interesting) clause of @match@ uses @tidy_and_unmix_eqns@
240 (a)~to get `as'- and `twiddle'-patterns out of the way (tidying), and
241 (b)~to do ``the mixture rule'' (SLPJ, p.~88) [which really {\em
242 un}mixes the equations], producing a list of equation-info
243 blocks, each block having as its first column of patterns either all
244 constructors, or all variables (or similar beasts), etc.
245
246 @match_unmixed_eqn_blks@ simply takes the place of the @foldr@ in the
247 Wadler-chapter @match@ (p.~93, last clause), and @match_unmixed_blk@
248 corresponds roughly to @matchVarCon@.
249
250 \begin{code}
251 match :: [Id]             -- Variables rep'ing the exprs we're matching with
252       -> Type             -- Type of the case expression
253       -> [EquationInfo]   -- Info about patterns, etc. (type synonym below)
254       -> DsM MatchResult  -- Desugared result!
255
256 match [] ty eqns
257   = ASSERT( not (null eqns) )
258     returnDs (foldr1 combineMatchResults match_results)
259   where
260     match_results = [ ASSERT( null (eqn_pats eqn) ) 
261                       eqn_rhs eqn
262                     | eqn <- eqns ]
263
264 match vars@(v:_) ty eqns
265   = ASSERT( not (null eqns ) )
266     do  {       -- Tidy the first pattern, generating
267                 -- auxiliary bindings if necessary
268           (aux_binds, tidy_eqns) <- mapAndUnzipM (tidyEqnInfo v) eqns
269
270                 -- Group the equations and match each group in turn
271         ; match_results <- mapM match_group (groupEquations tidy_eqns)
272
273         ; return (adjustMatchResult (foldr1 (.) aux_binds) $
274                   foldr1 combineMatchResults match_results) }
275   where
276     dropGroup :: [(PatGroup,EquationInfo)] -> [EquationInfo]
277     dropGroup = map snd
278
279     match_group :: [(PatGroup,EquationInfo)] -> DsM MatchResult
280     match_group eqns@((group,_) : _)
281       = case group of
282           PgAny     -> matchVariables  vars ty (dropGroup eqns)
283           PgCon _   -> matchConFamily  vars ty (subGroups eqns)
284           PgLit _   -> matchLiterals   vars ty (subGroups eqns)
285           PgN lit   -> matchNPats      vars ty (subGroups eqns)
286           PgNpK lit -> matchNPlusKPats vars ty (dropGroup eqns)
287           PgBang    -> matchBangs      vars ty (dropGroup eqns)
288           PgCo _    -> matchCoercion   vars ty (dropGroup eqns)
289
290 matchVariables :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
291 -- Real true variables, just like in matchVar, SLPJ p 94
292 -- No binding to do: they'll all be wildcards by now (done in tidy)
293 matchVariables (var:vars) ty eqns = match vars ty (shiftEqns eqns)
294
295 matchBangs :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
296 matchBangs (var:vars) ty eqns
297   = do  { match_result <- match (var:vars) ty (map shift eqns)
298         ; return (mkEvalMatchResult var ty match_result) }
299   where
300     shift eqn@(EqnInfo { eqn_pats = BangPat pat : pats })
301         = eqn { eqn_pats = unLoc pat : pats }
302
303 matchCoercion :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
304 -- Apply the coercion to the match variable and then match that
305 matchCoercion (var:vars) ty (eqn1:eqns)
306   = do  { let CoPat co pat _ = firstPat eqn1
307         ; var' <- newUniqueId (idName var) (hsPatType pat)
308         ; match_result <- match (var':vars) ty (map shift (eqn1:eqns))
309         ; rhs <- dsCoercion co (return (Var var))
310         ; return (mkCoLetMatchResult (NonRec var' rhs) match_result) }
311   where
312     shift eqn@(EqnInfo { eqn_pats = CoPat _ pat _ : pats })
313         = eqn { eqn_pats = pat : pats }
314 \end{code}
315
316 %************************************************************************
317 %*                                                                      *
318                 Tidying patterns
319 %*                                                                      *
320 %************************************************************************
321
322 Tidy up the leftmost pattern in an @EquationInfo@, given the variable @v@
323 which will be scrutinised.  This means:
324 \begin{itemize}
325 \item
326 Replace variable patterns @x@ (@x /= v@) with the pattern @_@,
327 together with the binding @x = v@.
328 \item
329 Replace the `as' pattern @x@@p@ with the pattern p and a binding @x = v@.
330 \item
331 Removing lazy (irrefutable) patterns (you don't want to know...).
332 \item
333 Converting explicit tuple-, list-, and parallel-array-pats into ordinary
334 @ConPats@. 
335 \item
336 Convert the literal pat "" to [].
337 \end{itemize}
338
339 The result of this tidying is that the column of patterns will include
340 {\em only}:
341 \begin{description}
342 \item[@WildPats@:]
343 The @VarPat@ information isn't needed any more after this.
344
345 \item[@ConPats@:]
346 @ListPats@, @TuplePats@, etc., are all converted into @ConPats@.
347
348 \item[@LitPats@ and @NPats@:]
349 @LitPats@/@NPats@ of ``known friendly types'' (Int, Char,
350 Float,  Double, at least) are converted to unboxed form; e.g.,
351 \tr{(NPat (HsInt i) _ _)} is converted to:
352 \begin{verbatim}
353 (ConPat I# _ _ [LitPat (HsIntPrim i)])
354 \end{verbatim}
355 \end{description}
356
357 \begin{code}
358 tidyEqnInfo :: Id -> EquationInfo
359             -> DsM (DsWrapper, EquationInfo)
360         -- DsM'd because of internal call to dsLHsBinds
361         --      and mkSelectorBinds.
362         -- "tidy1" does the interesting stuff, looking at
363         -- one pattern and fiddling the list of bindings.
364         --
365         -- POST CONDITION: head pattern in the EqnInfo is
366         --      WildPat
367         --      ConPat
368         --      NPat
369         --      LitPat
370         --      NPlusKPat
371         -- but no other
372
373 tidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats })
374   = tidy1 v pat         `thenDs` \ (wrap, pat') ->
375     returnDs (wrap, eqn { eqn_pats = pat' : pats })
376
377 tidy1 :: Id                     -- The Id being scrutinised
378       -> Pat Id                 -- The pattern against which it is to be matched
379       -> DsM (DsWrapper,        -- Extra bindings to do before the match
380               Pat Id)           -- Equivalent pattern
381
382 -------------------------------------------------------
383 --      (pat', mr') = tidy1 v pat mr
384 -- tidies the *outer level only* of pat, giving pat'
385 -- It eliminates many pattern forms (as-patterns, variable patterns,
386 -- list patterns, etc) yielding one of:
387 --      WildPat
388 --      ConPatOut
389 --      LitPat
390 --      NPat
391 --      NPlusKPat
392
393 tidy1 v (ParPat pat)      = tidy1 v (unLoc pat) 
394 tidy1 v (SigPatOut pat _) = tidy1 v (unLoc pat) 
395 tidy1 v (WildPat ty)      = returnDs (idWrapper, WildPat ty)
396
397         -- case v of { x -> mr[] }
398         -- = case v of { _ -> let x=v in mr[] }
399 tidy1 v (VarPat var)
400   = returnDs (wrapBind var v, WildPat (idType var)) 
401
402 tidy1 v (VarPatOut var binds)
403   = do  { prs <- dsLHsBinds binds
404         ; return (wrapBind var v . mkDsLet (Rec prs),
405                   WildPat (idType var)) }
406
407         -- case v of { x@p -> mr[] }
408         -- = case v of { p -> let x=v in mr[] }
409 tidy1 v (AsPat (L _ var) pat)
410   = do  { (wrap, pat') <- tidy1 v (unLoc pat)
411         ; return (wrapBind var v . wrap, pat') }
412
413 {- now, here we handle lazy patterns:
414     tidy1 v ~p bs = (v, v1 = case v of p -> v1 :
415                         v2 = case v of p -> v2 : ... : bs )
416
417     where the v_i's are the binders in the pattern.
418
419     ToDo: in "v_i = ... -> v_i", are the v_i's really the same thing?
420
421     The case expr for v_i is just: match [v] [(p, [], \ x -> Var v_i)] any_expr
422 -}
423
424 tidy1 v (LazyPat pat)
425   = do  { sel_prs <- mkSelectorBinds pat (Var v)
426         ; let sel_binds =  [NonRec b rhs | (b,rhs) <- sel_prs]
427         ; returnDs (mkDsLets sel_binds, WildPat (idType v)) }
428
429 tidy1 v (ListPat pats ty)
430   = returnDs (idWrapper, unLoc list_ConPat)
431   where
432     list_ty     = mkListTy ty
433     list_ConPat = foldr (\ x y -> mkPrefixConPat consDataCon [x, y] list_ty)
434                         (mkNilPat list_ty)
435                         pats
436
437 -- Introduce fake parallel array constructors to be able to handle parallel
438 -- arrays with the existing machinery for constructor pattern
439 tidy1 v (PArrPat pats ty)
440   = returnDs (idWrapper, unLoc parrConPat)
441   where
442     arity      = length pats
443     parrConPat = mkPrefixConPat (parrFakeCon arity) pats (mkPArrTy ty)
444
445 tidy1 v (TuplePat pats boxity ty)
446   = returnDs (idWrapper, unLoc tuple_ConPat)
447   where
448     arity = length pats
449     tuple_ConPat = mkPrefixConPat (tupleCon boxity arity) pats ty
450
451 tidy1 v (DictPat dicts methods)
452   = case num_of_d_and_ms of
453         0 -> tidy1 v (TuplePat [] Boxed unitTy) 
454         1 -> tidy1 v (unLoc (head dict_and_method_pats))
455         _ -> tidy1 v (mkVanillaTuplePat dict_and_method_pats Boxed)
456   where
457     num_of_d_and_ms      = length dicts + length methods
458     dict_and_method_pats = map nlVarPat (dicts ++ methods)
459
460 -- LitPats: we *might* be able to replace these w/ a simpler form
461 tidy1 v (LitPat lit)
462   = returnDs (idWrapper, tidyLitPat lit)
463
464 -- NPats: we *might* be able to replace these w/ a simpler form
465 tidy1 v (NPat lit mb_neg eq lit_ty)
466   = returnDs (idWrapper, tidyNPat lit mb_neg eq lit_ty)
467
468 -- Everything else goes through unchanged...
469
470 tidy1 v non_interesting_pat
471   = returnDs (idWrapper, non_interesting_pat)
472 \end{code}
473
474 \noindent
475 {\bf Previous @matchTwiddled@ stuff:}
476
477 Now we get to the only interesting part; note: there are choices for
478 translation [from Simon's notes]; translation~1:
479 \begin{verbatim}
480 deTwiddle [s,t] e
481 \end{verbatim}
482 returns
483 \begin{verbatim}
484 [ w = e,
485   s = case w of [s,t] -> s
486   t = case w of [s,t] -> t
487 ]
488 \end{verbatim}
489
490 Here \tr{w} is a fresh variable, and the \tr{w}-binding prevents multiple
491 evaluation of \tr{e}.  An alternative translation (No.~2):
492 \begin{verbatim}
493 [ w = case e of [s,t] -> (s,t)
494   s = case w of (s,t) -> s
495   t = case w of (s,t) -> t
496 ]
497 \end{verbatim}
498
499 %************************************************************************
500 %*                                                                      *
501 \subsubsection[improved-unmixing]{UNIMPLEMENTED idea for improved unmixing}
502 %*                                                                      *
503 %************************************************************************
504
505 We might be able to optimise unmixing when confronted by
506 only-one-constructor-possible, of which tuples are the most notable
507 examples.  Consider:
508 \begin{verbatim}
509 f (a,b,c) ... = ...
510 f d ... (e:f) = ...
511 f (g,h,i) ... = ...
512 f j ...       = ...
513 \end{verbatim}
514 This definition would normally be unmixed into four equation blocks,
515 one per equation.  But it could be unmixed into just one equation
516 block, because if the one equation matches (on the first column),
517 the others certainly will.
518
519 You have to be careful, though; the example
520 \begin{verbatim}
521 f j ...       = ...
522 -------------------
523 f (a,b,c) ... = ...
524 f d ... (e:f) = ...
525 f (g,h,i) ... = ...
526 \end{verbatim}
527 {\em must} be broken into two blocks at the line shown; otherwise, you
528 are forcing unnecessary evaluation.  In any case, the top-left pattern
529 always gives the cue.  You could then unmix blocks into groups of...
530 \begin{description}
531 \item[all variables:]
532 As it is now.
533 \item[constructors or variables (mixed):]
534 Need to make sure the right names get bound for the variable patterns.
535 \item[literals or variables (mixed):]
536 Presumably just a variant on the constructor case (as it is now).
537 \end{description}
538
539 %************************************************************************
540 %*                                                                      *
541 %*  matchWrapper: a convenient way to call @match@                      *
542 %*                                                                      *
543 %************************************************************************
544 \subsection[matchWrapper]{@matchWrapper@: a convenient interface to @match@}
545
546 Calls to @match@ often involve similar (non-trivial) work; that work
547 is collected here, in @matchWrapper@.  This function takes as
548 arguments:
549 \begin{itemize}
550 \item
551 Typchecked @Matches@ (of a function definition, or a case or lambda
552 expression)---the main input;
553 \item
554 An error message to be inserted into any (runtime) pattern-matching
555 failure messages.
556 \end{itemize}
557
558 As results, @matchWrapper@ produces:
559 \begin{itemize}
560 \item
561 A list of variables (@Locals@) that the caller must ``promise'' to
562 bind to appropriate values; and
563 \item
564 a @CoreExpr@, the desugared output (main result).
565 \end{itemize}
566
567 The main actions of @matchWrapper@ include:
568 \begin{enumerate}
569 \item
570 Flatten the @[TypecheckedMatch]@ into a suitable list of
571 @EquationInfo@s.
572 \item
573 Create as many new variables as there are patterns in a pattern-list
574 (in any one of the @EquationInfo@s).
575 \item
576 Create a suitable ``if it fails'' expression---a call to @error@ using
577 the error-string input; the {\em type} of this fail value can be found
578 by examining one of the RHS expressions in one of the @EquationInfo@s.
579 \item
580 Call @match@ with all of this information!
581 \end{enumerate}
582
583 \begin{code}
584 matchWrapper :: HsMatchContext Name     -- For shadowing warning messages
585              -> MatchGroup Id           -- Matches being desugared
586              -> DsM ([Id], CoreExpr)    -- Results
587 \end{code}
588
589  There is one small problem with the Lambda Patterns, when somebody
590  writes something similar to:
591 \begin{verbatim}
592     (\ (x:xs) -> ...)
593 \end{verbatim}
594  he/she don't want a warning about incomplete patterns, that is done with 
595  the flag @opt_WarnSimplePatterns@.
596  This problem also appears in the:
597 \begin{itemize}
598 \item @do@ patterns, but if the @do@ can fail
599       it creates another equation if the match can fail
600       (see @DsExpr.doDo@ function)
601 \item @let@ patterns, are treated by @matchSimply@
602    List Comprension Patterns, are treated by @matchSimply@ also
603 \end{itemize}
604
605 We can't call @matchSimply@ with Lambda patterns,
606 due to the fact that lambda patterns can have more than
607 one pattern, and match simply only accepts one pattern.
608
609 JJQC 30-Nov-1997
610
611 \begin{code}
612 matchWrapper ctxt (MatchGroup matches match_ty)
613   = do  { eqns_info   <- mapM mk_eqn_info matches
614         ; new_vars    <- selectMatchVars arg_pats
615         ; result_expr <- matchEquations ctxt new_vars eqns_info rhs_ty
616         ; return (new_vars, result_expr) }
617   where
618     arg_pats    = map unLoc (hsLMatchPats (head matches))
619     n_pats      = length arg_pats
620     (_, rhs_ty) = splitFunTysN n_pats match_ty
621
622     mk_eqn_info (L _ (Match pats _ grhss))
623       = do { let upats = map unLoc pats
624            ; match_result <- dsGRHSs ctxt upats grhss rhs_ty
625            ; return (EqnInfo { eqn_pats = upats, eqn_rhs  = match_result}) }
626
627
628 matchEquations  :: HsMatchContext Name
629                 -> [Id] -> [EquationInfo] -> Type
630                 -> DsM CoreExpr
631 matchEquations ctxt vars eqns_info rhs_ty
632   = do  { dflags <- getDOptsDs
633         ; locn   <- getSrcSpanDs
634         ; let   ds_ctxt      = DsMatchContext ctxt locn
635                 error_string = matchContextErrString ctxt
636
637         ; match_result <- match_fun dflags ds_ctxt vars rhs_ty eqns_info
638
639         ; fail_expr <- mkErrorAppDs pAT_ERROR_ID rhs_ty error_string
640         ; extractMatchResult match_result fail_expr }
641   where 
642     match_fun dflags ds_ctxt
643        = case ctxt of 
644            LambdaExpr | dopt Opt_WarnSimplePatterns dflags -> matchCheck ds_ctxt
645                       | otherwise                          -> match
646            _                                               -> matchCheck ds_ctxt
647 \end{code}
648
649 %************************************************************************
650 %*                                                                      *
651 \subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern}
652 %*                                                                      *
653 %************************************************************************
654
655 @mkSimpleMatch@ is a wrapper for @match@ which deals with the
656 situation where we want to match a single expression against a single
657 pattern. It returns an expression.
658
659 \begin{code}
660 matchSimply :: CoreExpr                 -- Scrutinee
661             -> HsMatchContext Name      -- Match kind
662             -> LPat Id                  -- Pattern it should match
663             -> CoreExpr                 -- Return this if it matches
664             -> CoreExpr                 -- Return this if it doesn't
665             -> DsM CoreExpr
666
667 matchSimply scrut hs_ctx pat result_expr fail_expr
668   = let
669       match_result = cantFailMatchResult result_expr
670       rhs_ty       = exprType fail_expr
671         -- Use exprType of fail_expr, because won't refine in the case of failure!
672     in 
673     matchSinglePat scrut hs_ctx pat rhs_ty match_result `thenDs` \ match_result' ->
674     extractMatchResult match_result' fail_expr
675
676
677 matchSinglePat :: CoreExpr -> HsMatchContext Name -> LPat Id
678                -> Type -> MatchResult -> DsM MatchResult
679 matchSinglePat (Var var) hs_ctx (L _ pat) ty match_result
680   = getDOptsDs                          `thenDs` \ dflags ->
681     getSrcSpanDs                        `thenDs` \ locn ->
682     let
683         match_fn dflags
684            | dopt Opt_WarnSimplePatterns dflags = matchCheck ds_ctx
685            | otherwise                          = match
686            where
687              ds_ctx = DsMatchContext hs_ctx locn
688     in
689     match_fn dflags [var] ty [EqnInfo { eqn_pats = [pat], eqn_rhs  = match_result }]
690
691 matchSinglePat scrut hs_ctx pat ty match_result
692   = selectSimpleMatchVarL pat                           `thenDs` \ var ->
693     matchSinglePat (Var var) hs_ctx pat ty match_result `thenDs` \ match_result' ->
694     returnDs (adjustMatchResult (bindNonRec var scrut) match_result')
695 \end{code}
696
697
698 %************************************************************************
699 %*                                                                      *
700                 Pattern classification
701 %*                                                                      *
702 %************************************************************************
703
704 \begin{code}
705 data PatGroup
706   = PgAny               -- Immediate match: variables, wildcards, 
707                         --                  lazy patterns
708   | PgCon DataCon       -- Constructor patterns (incl list, tuple)
709   | PgLit Literal       -- Literal patterns
710   | PgN   Literal       -- Overloaded literals
711   | PgNpK Literal       -- n+k patterns
712   | PgBang              -- Bang patterns
713   | PgCo Type           -- Coercion patterns; the type is the type
714                         --      of the pattern *inside*
715
716
717 groupEquations :: [EquationInfo] -> [[(PatGroup, EquationInfo)]]
718 groupEquations eqns
719   = runs same_gp [(patGroup (firstPat eqn), eqn) | eqn <- eqns]
720   where
721     same_gp :: (PatGroup,EquationInfo) -> (PatGroup,EquationInfo) -> Bool
722     (pg1,_) `same_gp` (pg2,_) = pg1 `sameGroup` pg2
723
724 subGroups :: [(PatGroup, EquationInfo)] -> [[EquationInfo]]
725 -- Input is a particular group.  The result sub-groups the 
726 -- equations by with particular constructor, literal etc they match.
727 -- The order may be swizzled, so the matching should be order-independent
728 subGroups groups = map (map snd) (equivClasses cmp groups)
729   where
730     (pg1, _) `cmp` (pg2, _) = pg1 `cmp_pg` pg2
731     (PgCon c1) `cmp_pg` (PgCon c2) = c1 `compare` c2
732     (PgLit l1) `cmp_pg` (PgLit l2) = l1 `compare` l2
733     (PgN   l1) `cmp_pg` (PgN   l2) = l1 `compare` l2
734         -- These are the only cases that are every sub-grouped
735
736 sameGroup :: PatGroup -> PatGroup -> Bool
737 -- Same group means that a single case expression 
738 -- or test will suffice to match both, *and* the order
739 -- of testing within the group is insignificant.
740 sameGroup PgAny      PgAny      = True
741 sameGroup PgBang     PgBang     = True
742 sameGroup (PgCon _)  (PgCon _)  = True          -- One case expression
743 sameGroup (PgLit _)  (PgLit _)  = True          -- One case expression
744 sameGroup (PgN l1)   (PgN l2)   = True          -- Needs conditionals
745 sameGroup (PgNpK l1) (PgNpK l2) = l1==l2        -- Order is significant
746                                                 -- See Note [Order of n+k]
747 sameGroup (PgCo t1)  (PgCo t2)  = t1 `coreEqType` t2
748 sameGroup _          _          = False
749  
750 patGroup :: Pat Id -> PatGroup
751 patGroup (WildPat {})                 = PgAny
752 patGroup (BangPat {})                 = PgBang  
753 patGroup (ConPatOut { pat_con = dc }) = PgCon (unLoc dc)
754 patGroup (LitPat lit)                 = PgLit (hsLitKey lit)
755 patGroup (NPat olit mb_neg _ _)       = PgN   (hsOverLitKey olit (isJust mb_neg))
756 patGroup (NPlusKPat _ olit _ _)       = PgNpK (hsOverLitKey olit False)
757 patGroup (CoPat _ p _)                = PgCo  (hsPatType p)     -- Type of inner pattern
758 patGroup pat = pprPanic "patGroup" (ppr pat)
759 \end{code}
760
761 Note [Order of n+k]
762 ~~~~~~~~~~~~~~~~~~~
763 WATCH OUT!  Consider
764
765         f (n+1) = ...
766         f (n+2) = ...
767         f (n+1) = ...
768
769 We can't group the first and third together, because the second may match 
770 the same thing as the first.  Contrast
771         f 1 = ...
772         f 2 = ...
773         f 1 = ...
774 where we can group the first and third.  Hence we don't regard (n+1) and
775 (n+2) as part of the same group.