2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[Main_match]{The @match@ function}
7 module Match ( match, matchExport, matchWrapper, matchSimply, matchSinglePat ) where
9 #include "HsVersions.h"
11 import {-# SOURCE #-} DsExpr( dsExpr )
12 import CmdLineOpts ( DynFlag(..), dopt )
14 import TcHsSyn ( TypecheckedPat, TypecheckedMatch, TypecheckedMatchContext, hsPatType )
15 import Check ( check, ExhaustivePat )
17 import CoreUtils ( bindNonRec )
19 import DsGRHSs ( dsGRHSs )
21 import Id ( idType, recordSelectorFieldLabel, Id )
22 import DataCon ( dataConFieldLabels, dataConInstOrigArgTys )
23 import MatchCon ( matchConFamily )
24 import MatchLit ( matchLiterals )
25 import PrelInfo ( pAT_ERROR_ID )
26 import TcType ( mkTyVarTys, Type, tcTyConAppArgs, tcEqType )
27 import TysWiredIn ( consDataCon, mkTupleTy, mkListTy,
28 tupleCon, parrFakeCon, mkPArrTy )
29 import BasicTypes ( Boxity(..) )
31 import SrcLoc ( noSrcLoc )
32 import Util ( lengthExceeds, isSingleton, notNull )
36 This function is a wrapper of @match@, it must be called from all the parts where
37 it was called match, but only substitutes the firs call, ....
38 if the associated flags are declared, warnings will be issued.
39 It can not be called matchWrapper because this name already exists :-(
44 matchExport :: [Id] -- Vars rep'ing the exprs we're matching with
45 -> [EquationInfo] -- Info about patterns, etc. (type synonym below)
46 -> DsM MatchResult -- Desugared result!
50 = getDOptsDs `thenDs` \ dflags ->
51 matchExport_really dflags vars qs
53 matchExport_really dflags vars qs@((EqnInfo _ ctx _ (MatchResult _ _)) : _)
54 | incomplete && shadow =
55 dsShadowWarn ctx eqns_shadow `thenDs` \ () ->
56 dsIncompleteWarn ctx pats `thenDs` \ () ->
59 dsIncompleteWarn ctx pats `thenDs` \ () ->
62 dsShadowWarn ctx eqns_shadow `thenDs` \ () ->
66 where (pats,indexs) = check qs
67 incomplete = dopt Opt_WarnIncompletePatterns dflags
69 shadow = dopt Opt_WarnOverlappingPatterns dflags
70 && sizeUniqSet indexs < no_eqns
72 unused_eqns = uniqSetToList (mkUniqSet [1..no_eqns] `minusUniqSet` indexs)
73 eqns_shadow = map (\n -> qs!!(n - 1)) unused_eqns
76 This variable shows the maximum number of lines of output generated for warnings.
77 It will limit the number of patterns/equations displayed to@ maximum_output@.
79 (ToDo: add command-line option?)
85 The next two functions create the warning message.
88 dsShadowWarn :: DsMatchContext -> [EquationInfo] -> DsM ()
89 dsShadowWarn ctx@(DsMatchContext kind _ _) qs = dsWarn warn
91 warn | qs `lengthExceeds` maximum_output
92 = pp_context ctx (ptext SLIT("are overlapped"))
93 (\ f -> vcat (map (ppr_eqn f kind) (take maximum_output qs)) $$
96 = pp_context ctx (ptext SLIT("are overlapped"))
97 (\ f -> vcat $ map (ppr_eqn f kind) qs)
100 dsIncompleteWarn :: DsMatchContext -> [ExhaustivePat] -> DsM ()
101 dsIncompleteWarn ctx@(DsMatchContext kind _ _) pats = dsWarn warn
103 warn = pp_context ctx (ptext SLIT("are non-exhaustive"))
104 (\f -> hang (ptext SLIT("Patterns not matched:"))
105 4 ((vcat $ map (ppr_incomplete_pats kind)
106 (take maximum_output pats))
109 dots | pats `lengthExceeds` maximum_output = ptext SLIT("...")
112 pp_context NoMatchContext msg rest_of_msg_fun
113 = (noSrcLoc, ptext SLIT("Some match(es)") <+> hang msg 8 (rest_of_msg_fun id))
115 pp_context (DsMatchContext kind pats loc) msg rest_of_msg_fun
116 = (loc, vcat [ptext SLIT("Pattern match(es)") <+> msg,
117 sep [ptext SLIT("In") <+> ppr_match <> char ':', nest 4 (rest_of_msg_fun pref)]])
121 FunRhs fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp)
122 other -> (pprMatchContext kind, \ pp -> pp)
124 ppr_pats pats = sep (map ppr pats)
126 ppr_shadow_pats kind pats
127 = sep [ppr_pats pats, matchSeparator kind, ptext SLIT("...")]
129 ppr_incomplete_pats kind (pats,[]) = ppr_pats pats
130 ppr_incomplete_pats kind (pats,constraints) =
131 sep [ppr_pats pats, ptext SLIT("with"),
132 sep (map ppr_constraint constraints)]
135 ppr_constraint (var,pats) = sep [ppr var, ptext SLIT("`notElem`"), ppr pats]
137 ppr_eqn prefixF kind (EqnInfo _ _ pats _) = prefixF (ppr_shadow_pats kind pats)
141 The function @match@ is basically the same as in the Wadler chapter,
142 except it is monadised, to carry around the name supply, info about
145 Notes on @match@'s arguments, assuming $m$ equations and $n$ patterns:
148 A list of $n$ variable names, those variables presumably bound to the
149 $n$ expressions being matched against the $n$ patterns. Using the
150 list of $n$ expressions as the first argument showed no benefit and
154 The second argument, a list giving the ``equation info'' for each of
158 the $n$ patterns for that equation, and
160 a list of Core bindings [@(Id, CoreExpr)@ pairs] to be ``stuck on
161 the front'' of the matching code, as in:
167 and finally: (ToDo: fill in)
169 The right way to think about the ``after-match function'' is that it
170 is an embryonic @CoreExpr@ with a ``hole'' at the end for the
171 final ``else expression''.
174 There is a type synonym, @EquationInfo@, defined in module @DsUtils@.
176 An experiment with re-ordering this information about equations (in
177 particular, having the patterns available in column-major order)
181 A default expression---what to evaluate if the overall pattern-match
182 fails. This expression will (almost?) always be
183 a measly expression @Var@, unless we know it will only be used once
184 (as we do in @glue_success_exprs@).
186 Leaving out this third argument to @match@ (and slamming in lots of
187 @Var "fail"@s) is a positively {\em bad} idea, because it makes it
188 impossible to share the default expressions. (Also, it stands no
189 chance of working in our post-upheaval world of @Locals@.)
191 So, the full type signature:
193 match :: [Id] -- Variables rep'ing the exprs we're matching with
194 -> [EquationInfo] -- Info about patterns, etc. (type synonym below)
195 -> DsM MatchResult -- Desugared result!
198 Note: @match@ is often called via @matchWrapper@ (end of this module),
199 a function that does much of the house-keeping that goes with a call
202 It is also worth mentioning the {\em typical} way a block of equations
203 is desugared with @match@. At each stage, it is the first column of
204 patterns that is examined. The steps carried out are roughly:
207 Tidy the patterns in column~1 with @tidyEqnInfo@ (this may add
208 bindings to the second component of the equation-info):
211 Remove the `as' patterns from column~1.
213 Make all constructor patterns in column~1 into @ConPats@, notably
214 @ListPats@ and @TuplePats@.
216 Handle any irrefutable (or ``twiddle'') @LazyPats@.
219 Now {\em unmix} the equations into {\em blocks} [w/ local function
220 @unmix_eqns@], in which the equations in a block all have variable
221 patterns in column~1, or they all have constructor patterns in ...
222 (see ``the mixture rule'' in SLPJ).
224 Call @matchEqnBlock@ on each block of equations; it will do the
225 appropriate thing for each kind of column-1 pattern, usually ending up
226 in a recursive call to @match@.
229 %************************************************************************
231 %* match: empty rule *
233 %************************************************************************
234 \subsection[Match-empty-rule]{The ``empty rule''}
236 We are a little more paranoid about the ``empty rule'' (SLPJ, p.~87)
237 than the Wadler-chapter code for @match@ (p.~93, first @match@ clause).
238 And gluing the ``success expressions'' together isn't quite so pretty.
242 = returnDs (foldr1 combineMatchResults match_results)
244 match_results = [ ASSERT( null pats) mr
245 | EqnInfo _ _ pats mr <- eqns_info ]
249 %************************************************************************
251 %* match: non-empty rule *
253 %************************************************************************
254 \subsection[Match-nonempty]{@match@ when non-empty: unmixing}
256 This (more interesting) clause of @match@ uses @tidy_and_unmix_eqns@
257 (a)~to get `as'- and `twiddle'-patterns out of the way (tidying), and
258 (b)~to do ``the mixture rule'' (SLPJ, p.~88) [which really {\em
259 un}mixes the equations], producing a list of equation-info
260 blocks, each block having as its first column of patterns either all
261 constructors, or all variables (or similar beasts), etc.
263 @match_unmixed_eqn_blks@ simply takes the place of the @foldr@ in the
264 Wadler-chapter @match@ (p.~93, last clause), and @match_unmixed_blk@
265 corresponds roughly to @matchVarCon@.
268 match vars@(v:vs) eqns_info
269 = mapDs (tidyEqnInfo v) eqns_info `thenDs` \ tidy_eqns_info ->
271 tidy_eqns_blks = unmix_eqns tidy_eqns_info
273 mapDs (matchEqnBlock vars) tidy_eqns_blks `thenDs` \ match_results ->
274 returnDs (foldr1 combineMatchResults match_results)
277 unmix_eqns [eqn] = [ [eqn] ]
278 unmix_eqns (eq1@(EqnInfo _ _ (p1:p1s) _) : eq2@(EqnInfo _ _ (p2:p2s) _) : eqs)
279 = if ( (isWildPat p1 && isWildPat p2)
280 || (isConPat p1 && isConPat p2)
281 || (isLitPat p1 && isLitPat p2) ) then
282 eq1 `tack_onto` unmixed_rest
284 [ eq1 ] : unmixed_rest
286 unmixed_rest = unmix_eqns (eq2:eqs)
288 x `tack_onto` xss = ( x : head xss) : tail xss
291 Tidy up the leftmost pattern in an @EquationInfo@, given the variable @v@
292 which will be scrutinised. This means:
295 Replace variable patterns @x@ (@x /= v@) with the pattern @_@,
296 together with the binding @x = v@.
298 Replace the `as' pattern @x@@p@ with the pattern p and a binding @x = v@.
300 Removing lazy (irrefutable) patterns (you don't want to know...).
302 Converting explicit tuple-, list-, and parallel-array-pats into ordinary
305 Convert the literal pat "" to [].
308 The result of this tidying is that the column of patterns will include
312 The @VarPat@ information isn't needed any more after this.
315 @ListPats@, @TuplePats@, etc., are all converted into @ConPats@.
317 \item[@LitPats@ and @NPats@:]
318 @LitPats@/@NPats@ of ``known friendly types'' (Int, Char,
319 Float, Double, at least) are converted to unboxed form; e.g.,
320 \tr{(NPat (HsInt i) _ _)} is converted to:
322 (ConPat I# _ _ [LitPat (HsIntPrim i)])
327 tidyEqnInfo :: Id -> EquationInfo -> DsM EquationInfo
328 -- DsM'd because of internal call to "match".
329 -- "tidy1" does the interesting stuff, looking at
330 -- one pattern and fiddling the list of bindings.
332 -- POST CONDITION: head pattern in the EqnInfo is
341 tidyEqnInfo v (EqnInfo n ctx (pat : pats) match_result)
342 = tidy1 v pat match_result `thenDs` \ (pat', match_result') ->
343 returnDs (EqnInfo n ctx (pat' : pats) match_result')
346 tidy1 :: Id -- The Id being scrutinised
347 -> TypecheckedPat -- The pattern against which it is to be matched
348 -> MatchResult -- Current thing do do after matching
349 -> DsM (TypecheckedPat, -- Equivalent pattern
350 MatchResult) -- Augmented thing to do afterwards
351 -- The augmentation usually takes the form
352 -- of new bindings to be added to the front
354 -------------------------------------------------------
355 -- (pat', mr') = tidy1 v pat mr
356 -- tidies the *outer level only* of pat, giving pat'
357 -- It eliminates many pattern forms (as-patterns, variable patterns,
358 -- list patterns, etc) yielding one of:
366 tidy1 v (ParPat pat) match_result
367 = tidy1 v pat match_result
369 -- case v of { x -> mr[] }
370 -- = case v of { _ -> let x=v in mr[] }
371 tidy1 v (VarPat var) match_result
372 = returnDs (WildPat (idType var), match_result')
374 match_result' | v == var = match_result
375 | otherwise = adjustMatchResult (bindNonRec var (Var v)) match_result
377 -- case v of { x@p -> mr[] }
378 -- = case v of { p -> let x=v in mr[] }
379 tidy1 v (AsPat var pat) match_result
380 = tidy1 v pat match_result'
382 match_result' | v == var = match_result
383 | otherwise = adjustMatchResult (bindNonRec var (Var v)) match_result
385 tidy1 v (WildPat ty) match_result
386 = returnDs (WildPat ty, match_result)
388 {- now, here we handle lazy patterns:
389 tidy1 v ~p bs = (v, v1 = case v of p -> v1 :
390 v2 = case v of p -> v2 : ... : bs )
392 where the v_i's are the binders in the pattern.
394 ToDo: in "v_i = ... -> v_i", are the v_i's really the same thing?
396 The case expr for v_i is just: match [v] [(p, [], \ x -> Var v_i)] any_expr
399 tidy1 v (LazyPat pat) match_result
400 = mkSelectorBinds pat (Var v) `thenDs` \ sel_binds ->
401 returnDs (WildPat (idType v),
402 mkCoLetsMatchResult [NonRec b rhs | (b,rhs) <- sel_binds] match_result)
404 -- re-express <con-something> as (ConPat ...) [directly]
406 tidy1 v (ConPatOut con ps pat_ty ex_tvs dicts) match_result
407 = returnDs (ConPatOut con tidy_ps pat_ty ex_tvs dicts, match_result)
409 tidy_ps = PrefixCon (tidy_con con pat_ty ex_tvs ps)
411 tidy1 v (ListPat pats ty) match_result
412 = returnDs (list_ConPat, match_result)
414 list_ty = mkListTy ty
415 list_ConPat = foldr (\ x y -> mkPrefixConPat consDataCon [x, y] list_ty)
419 -- introduce fake parallel array constructors to be able to handle parallel
420 -- arrays with the existing machinery for constructor pattern
422 tidy1 v (PArrPat pats ty) match_result
423 = returnDs (parrConPat, match_result)
426 parrConPat = mkPrefixConPat (parrFakeCon arity) pats (mkPArrTy ty)
428 tidy1 v (TuplePat pats boxity) match_result
429 = returnDs (tuple_ConPat, match_result)
432 tuple_ConPat = mkPrefixConPat (tupleCon boxity arity) pats
433 (mkTupleTy boxity arity (map hsPatType pats))
435 tidy1 v (DictPat dicts methods) match_result
436 = case num_of_d_and_ms of
437 0 -> tidy1 v (TuplePat [] Boxed) match_result
438 1 -> tidy1 v (head dict_and_method_pats) match_result
439 _ -> tidy1 v (TuplePat dict_and_method_pats Boxed) match_result
441 num_of_d_and_ms = length dicts + length methods
442 dict_and_method_pats = map VarPat (dicts ++ methods)
444 -- LitPats: we *might* be able to replace these w/ a simpler form
445 tidy1 v pat@(LitPat lit) match_result
446 = returnDs (tidyLitPat lit pat, match_result)
448 -- NPats: we *might* be able to replace these w/ a simpler form
449 tidy1 v pat@(NPatOut lit lit_ty _) match_result
450 = returnDs (tidyNPat lit lit_ty pat, match_result)
452 -- and everything else goes through unchanged...
454 tidy1 v non_interesting_pat match_result
455 = returnDs (non_interesting_pat, match_result)
458 tidy_con data_con pat_ty ex_tvs (PrefixCon ps) = ps
459 tidy_con data_con pat_ty ex_tvs (InfixCon p1 p2) = [p1,p2]
460 tidy_con data_con pat_ty ex_tvs (RecCon rpats)
462 = -- Special case for C {}, which can be used for
463 -- a constructor that isn't declared to have
465 map WildPat con_arg_tys'
468 = map mk_pat tagged_arg_tys
470 -- Boring stuff to find the arg-tys of the constructor
471 inst_tys = tcTyConAppArgs pat_ty -- Newtypes must be opaque
472 con_arg_tys' = dataConInstOrigArgTys data_con (inst_tys ++ mkTyVarTys ex_tvs)
473 tagged_arg_tys = con_arg_tys' `zip` (dataConFieldLabels data_con)
475 -- mk_pat picks a WildPat of the appropriate type for absent fields,
476 -- and the specified pattern for present fields
477 mk_pat (arg_ty, lbl) = case [pat | (sel_id,pat) <- rpats,
478 recordSelectorFieldLabel sel_id == lbl
480 (pat:pats) -> ASSERT( null pats )
486 {\bf Previous @matchTwiddled@ stuff:}
488 Now we get to the only interesting part; note: there are choices for
489 translation [from Simon's notes]; translation~1:
496 s = case w of [s,t] -> s
497 t = case w of [s,t] -> t
501 Here \tr{w} is a fresh variable, and the \tr{w}-binding prevents multiple
502 evaluation of \tr{e}. An alternative translation (No.~2):
504 [ w = case e of [s,t] -> (s,t)
505 s = case w of (s,t) -> s
506 t = case w of (s,t) -> t
510 %************************************************************************
512 \subsubsection[improved-unmixing]{UNIMPLEMENTED idea for improved unmixing}
514 %************************************************************************
516 We might be able to optimise unmixing when confronted by
517 only-one-constructor-possible, of which tuples are the most notable
525 This definition would normally be unmixed into four equation blocks,
526 one per equation. But it could be unmixed into just one equation
527 block, because if the one equation matches (on the first column),
528 the others certainly will.
530 You have to be careful, though; the example
538 {\em must} be broken into two blocks at the line shown; otherwise, you
539 are forcing unnecessary evaluation. In any case, the top-left pattern
540 always gives the cue. You could then unmix blocks into groups of...
542 \item[all variables:]
544 \item[constructors or variables (mixed):]
545 Need to make sure the right names get bound for the variable patterns.
546 \item[literals or variables (mixed):]
547 Presumably just a variant on the constructor case (as it is now).
550 %************************************************************************
552 %* match on an unmixed block: the real business *
554 %************************************************************************
555 \subsection[matchEqnBlock]{@matchEqnBlock@: getting down to business}
557 The function @matchEqnBlock@ is where the matching stuff sets to
558 work a block of equations, to which the mixture rule has been applied.
559 Its arguments and results are the same as for the ``top-level'' @match@.
562 matchEqnBlock :: [Id]
566 matchEqnBlock [] _ = panic "matchEqnBlock: no names"
568 matchEqnBlock all_vars@(var:vars) eqns_info
569 | isWildPat first_pat
570 = ASSERT( all isWildPat column_1_pats ) -- Sanity check
571 -- Real true variables, just like in matchVar, SLPJ p 94
572 -- No binding to do: they'll all be wildcards by now (done in tidy)
573 match vars remaining_eqns_info
576 = ASSERT( patsAreAllCons column_1_pats )
577 matchConFamily all_vars eqns_info
580 = ASSERT( patsAreAllLits column_1_pats )
581 -- see notes in MatchLiteral
582 -- not worried about the same literal more than once in a column
583 -- (ToDo: sort this out later)
584 matchLiterals all_vars eqns_info
587 = ASSERT( isSingleton eqns_info )
588 matchSigPat all_vars (head eqns_info)
590 first_pat = head column_1_pats
591 column_1_pats = [pat | EqnInfo _ _ (pat:_) _ <- eqns_info]
592 remaining_eqns_info = [EqnInfo n ctx pats match_result | EqnInfo n ctx (_:pats) match_result <- eqns_info]
595 A SigPat is a type coercion and must be handled one at at time. We can't
596 combine them unless the type of the pattern inside is identical, and we don't
597 bother to check for that. For example:
599 data T = T1 Int | T2 Bool
600 f :: (forall a. a -> a) -> T -> t
601 f (g::Int->Int) (T1 i) = T1 (g i)
602 f (g::Bool->Bool) (T2 b) = T2 (g b)
604 We desugar this as follows:
606 f = \ g::(forall a. a->a) t::T ->
608 in case t of { T1 i -> T1 (gi i)
611 in case t of { T2 b -> T2 (gb b)
614 Note that we do not treat the first column of patterns as a
615 column of variables, because the coerced variables (gi, gb)
616 would be of different types. So we get rather grotty code.
617 But I don't think this is a common case, and if it was we could
618 doubtless improve it.
620 Meanwhile, the strategy is:
621 * treat each SigPat coercion (always non-identity coercions)
623 * deal with the stuff inside, and then wrap a binding round
624 the result to bind the new variable (gi, gb, etc)
627 matchSigPat :: [Id] -> EquationInfo -> DsM MatchResult
628 matchSigPat (var:vars) (EqnInfo n ctx (SigPatOut pat ty co_fn : pats) result)
629 = selectMatchVar pat `thenDs` \ new_var ->
630 dsExpr (HsApp co_fn (HsVar var)) `thenDs` \ rhs ->
631 match (new_var:vars) [EqnInfo n ctx (pat:pats) result] `thenDs` \ result' ->
632 returnDs (adjustMatchResult (bindNonRec new_var rhs) result')
635 %************************************************************************
637 %* matchWrapper: a convenient way to call @match@ *
639 %************************************************************************
640 \subsection[matchWrapper]{@matchWrapper@: a convenient interface to @match@}
642 Calls to @match@ often involve similar (non-trivial) work; that work
643 is collected here, in @matchWrapper@. This function takes as
647 Typchecked @Matches@ (of a function definition, or a case or lambda
648 expression)---the main input;
650 An error message to be inserted into any (runtime) pattern-matching
654 As results, @matchWrapper@ produces:
657 A list of variables (@Locals@) that the caller must ``promise'' to
658 bind to appropriate values; and
660 a @CoreExpr@, the desugared output (main result).
663 The main actions of @matchWrapper@ include:
666 Flatten the @[TypecheckedMatch]@ into a suitable list of
669 Create as many new variables as there are patterns in a pattern-list
670 (in any one of the @EquationInfo@s).
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.
676 Call @match@ with all of this information!
680 matchWrapper :: TypecheckedMatchContext -- For shadowing warning messages
681 -> [TypecheckedMatch] -- Matches being desugared
682 -> DsM ([Id], CoreExpr) -- Results
685 There is one small problem with the Lambda Patterns, when somebody
686 writes something similar to:
690 he/she don't want a warning about incomplete patterns, that is done with
691 the flag @opt_WarnSimplePatterns@.
692 This problem also appears in the:
694 \item @do@ patterns, but if the @do@ can fail
695 it creates another equation if the match can fail
696 (see @DsExpr.doDo@ function)
697 \item @let@ patterns, are treated by @matchSimply@
698 List Comprension Patterns, are treated by @matchSimply@ also
701 We can't call @matchSimply@ with Lambda patterns,
702 due to the fact that lambda patterns can have more than
703 one pattern, and match simply only accepts one pattern.
708 matchWrapper ctxt matches
709 = getDOptsDs `thenDs` \ dflags ->
710 flattenMatches ctxt matches `thenDs` \ (result_ty, eqns_info) ->
712 EqnInfo _ _ arg_pats _ : _ = eqns_info
713 error_string = matchContextErrString ctxt
715 mapDs selectMatchVar arg_pats `thenDs` \ new_vars ->
716 match_fun dflags new_vars eqns_info `thenDs` \ match_result ->
718 mkErrorAppDs pAT_ERROR_ID result_ty error_string `thenDs` \ fail_expr ->
719 extractMatchResult match_result fail_expr `thenDs` \ result_expr ->
720 returnDs (new_vars, result_expr)
721 where match_fun dflags
723 LambdaExpr | dopt Opt_WarnSimplePatterns dflags -> matchExport
728 %************************************************************************
730 \subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern}
732 %************************************************************************
734 @mkSimpleMatch@ is a wrapper for @match@ which deals with the
735 situation where we want to match a single expression against a single
736 pattern. It returns an expression.
739 matchSimply :: CoreExpr -- Scrutinee
740 -> TypecheckedMatchContext -- Match kind
741 -> TypecheckedPat -- Pattern it should match
742 -> CoreExpr -- Return this if it matches
743 -> CoreExpr -- Return this if it doesn't
746 matchSimply scrut kind pat result_expr fail_expr
747 = getSrcLocDs `thenDs` \ locn ->
749 ctx = DsMatchContext kind [pat] locn
750 match_result = cantFailMatchResult result_expr
752 matchSinglePat scrut ctx pat match_result `thenDs` \ match_result' ->
753 extractMatchResult match_result' fail_expr
756 matchSinglePat :: CoreExpr -> DsMatchContext -> TypecheckedPat
757 -> MatchResult -> DsM MatchResult
759 matchSinglePat (Var var) ctx pat match_result
760 = getDOptsDs `thenDs` \ dflags ->
761 match_fn dflags [var] [EqnInfo 1 ctx [pat] match_result]
764 | dopt Opt_WarnSimplePatterns dflags = matchExport
767 matchSinglePat scrut ctx pat match_result
768 = selectMatchVar pat `thenDs` \ var ->
769 matchSinglePat (Var var) ctx pat match_result `thenDs` \ match_result' ->
770 returnDs (adjustMatchResult (bindNonRec var scrut) match_result')
773 %************************************************************************
775 %* flattenMatches : create a list of EquationInfo *
777 %************************************************************************
779 \subsection[flattenMatches]{@flattenMatches@: create @[EquationInfo]@}
781 This is actually local to @matchWrapper@.
784 flattenMatches :: TypecheckedMatchContext
785 -> [TypecheckedMatch]
786 -> DsM (Type, [EquationInfo])
788 flattenMatches kind matches
789 = mapAndUnzipDs flatten_match (matches `zip` [1..]) `thenDs` \ (result_tys, eqn_infos) ->
791 result_ty = head result_tys
793 ASSERT( all (tcEqType result_ty) result_tys )
794 returnDs (result_ty, eqn_infos)
796 flatten_match (Match pats _ grhss, n)
797 = dsGRHSs kind pats grhss `thenDs` \ (ty, match_result) ->
798 getSrcLocDs `thenDs` \ locn ->
799 returnDs (ty, EqnInfo n (DsMatchContext kind pats locn) pats match_result)