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 CmdLineOpts ( opt_WarnIncompletePatterns, opt_WarnOverlappingPatterns,
12 opt_WarnSimplePatterns
15 import TcHsSyn ( TypecheckedPat, TypecheckedMatch )
16 import DsHsSyn ( outPatType )
17 import Check ( check, ExhaustivePat )
19 import CoreUtils ( bindNonRec )
21 import DsGRHSs ( dsGRHSs )
23 import Id ( idType, recordSelectorFieldLabel, Id )
24 import DataCon ( dataConFieldLabels, dataConInstOrigArgTys )
25 import MatchCon ( matchConFamily )
26 import MatchLit ( matchLiterals )
27 import PrelInfo ( pAT_ERROR_ID )
28 import Type ( splitAlgTyConApp, mkTyVarTys, Type )
29 import TysWiredIn ( nilDataCon, consDataCon, mkTupleTy, mkListTy, tupleCon )
30 import BasicTypes ( Boxity(..) )
32 import ErrUtils ( addErrLocHdrLine, dontAddErrLoc )
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!
48 matchExport vars qs@((EqnInfo _ ctx _ (MatchResult _ _)) : _)
49 | incomplete && shadow =
50 dsShadowWarn ctx eqns_shadow `thenDs` \ () ->
51 dsIncompleteWarn ctx pats `thenDs` \ () ->
54 dsIncompleteWarn ctx pats `thenDs` \ () ->
57 dsShadowWarn ctx eqns_shadow `thenDs` \ () ->
61 where (pats,indexs) = check qs
62 incomplete = opt_WarnIncompletePatterns && (length pats /= 0)
63 shadow = opt_WarnOverlappingPatterns && sizeUniqSet indexs < no_eqns
65 unused_eqns = uniqSetToList (mkUniqSet [1..no_eqns] `minusUniqSet` indexs)
66 eqns_shadow = map (\n -> qs!!(n - 1)) unused_eqns
69 This variable shows the maximum number of lines of output generated for warnings.
70 It will limit the number of patterns/equations displayed to@ maximum_output@.
72 (ToDo: add command-line option?)
78 The next two functions create the warning message.
81 dsShadowWarn :: DsMatchContext -> [EquationInfo] -> DsM ()
82 dsShadowWarn ctx@(DsMatchContext kind _ _) qs = dsWarn warn
84 warn | length qs > maximum_output
85 = pp_context ctx (ptext SLIT("are overlapped"))
86 (\ f -> vcat (map (ppr_eqn f kind) (take maximum_output qs)) $$
89 = pp_context ctx (ptext SLIT("are overlapped"))
90 (\ f -> vcat $ map (ppr_eqn f kind) qs)
93 dsIncompleteWarn :: DsMatchContext -> [ExhaustivePat] -> DsM ()
94 dsIncompleteWarn ctx@(DsMatchContext kind _ _) pats = dsWarn warn
96 warn = pp_context ctx (ptext SLIT("are non-exhaustive"))
97 (\f -> hang (ptext SLIT("Patterns not matched:"))
98 4 ((vcat $ map (ppr_incomplete_pats kind)
99 (take maximum_output pats))
102 dots | length pats > maximum_output = ptext SLIT("...")
105 pp_context NoMatchContext msg rest_of_msg_fun
106 = dontAddErrLoc "" (ptext SLIT("Some match(es)") <+> hang msg 8 (rest_of_msg_fun id))
108 pp_context (DsMatchContext kind pats loc) msg rest_of_msg_fun
109 = case pp_match kind pats of
111 addErrLocHdrLine loc message (nest 8 (rest_of_msg_fun pref))
113 message = ptext SLIT("Pattern match(es)") <+> msg <+> ppr_match <> char ':'
115 pp_match (FunMatch fun) pats
116 = let ppr_fun = ppr fun in
117 ( hsep [ptext SLIT("in the definition of function"), quotes ppr_fun]
118 , (\ x -> ppr_fun <+> x)
121 pp_match CaseMatch pats
122 = (hang (ptext SLIT("in a group of case alternatives beginning"))
127 pp_match RecUpdMatch pats
128 = (hang (ptext SLIT("in a record-update construct"))
133 pp_match PatBindMatch pats
134 = ( hang (ptext SLIT("in a pattern binding"))
139 pp_match LambdaMatch pats
140 = ( hang (ptext SLIT("in a lambda abstraction"))
145 pp_match DoBindMatch pats
146 = ( hang (ptext SLIT("in a `do' pattern binding"))
151 pp_match ListCompMatch pats
152 = ( hang (ptext SLIT("in a `list comprension' pattern binding"))
157 pp_match LetMatch pats
158 = ( hang (ptext SLIT("in a `let' pattern binding"))
163 ppr_pats pats = sep (map ppr pats)
165 separator (FunMatch _) = SLIT("=")
166 separator (CaseMatch) = SLIT("->")
167 separator (LambdaMatch) = SLIT("->")
168 separator (PatBindMatch) = panic "When is this used?"
169 separator (RecUpdMatch) = panic "When is this used?"
170 separator (DoBindMatch) = SLIT("<-")
171 separator (ListCompMatch) = SLIT("<-")
172 separator (LetMatch) = SLIT("=")
174 ppr_shadow_pats kind pats
175 = sep [ppr_pats pats, ptext (separator kind), ptext SLIT("...")]
177 ppr_incomplete_pats kind (pats,[]) = ppr_pats pats
178 ppr_incomplete_pats kind (pats,constraints) =
179 sep [ppr_pats pats, ptext SLIT("with"),
180 sep (map ppr_constraint constraints)]
183 ppr_constraint (var,pats) = sep [ppr var, ptext SLIT("`notElem`"), ppr pats]
185 ppr_eqn prefixF kind (EqnInfo _ _ pats _) = prefixF (ppr_shadow_pats kind pats)
189 The function @match@ is basically the same as in the Wadler chapter,
190 except it is monadised, to carry around the name supply, info about
193 Notes on @match@'s arguments, assuming $m$ equations and $n$ patterns:
196 A list of $n$ variable names, those variables presumably bound to the
197 $n$ expressions being matched against the $n$ patterns. Using the
198 list of $n$ expressions as the first argument showed no benefit and
202 The second argument, a list giving the ``equation info'' for each of
206 the $n$ patterns for that equation, and
208 a list of Core bindings [@(Id, CoreExpr)@ pairs] to be ``stuck on
209 the front'' of the matching code, as in:
215 and finally: (ToDo: fill in)
217 The right way to think about the ``after-match function'' is that it
218 is an embryonic @CoreExpr@ with a ``hole'' at the end for the
219 final ``else expression''.
222 There is a type synonym, @EquationInfo@, defined in module @DsUtils@.
224 An experiment with re-ordering this information about equations (in
225 particular, having the patterns available in column-major order)
229 A default expression---what to evaluate if the overall pattern-match
230 fails. This expression will (almost?) always be
231 a measly expression @Var@, unless we know it will only be used once
232 (as we do in @glue_success_exprs@).
234 Leaving out this third argument to @match@ (and slamming in lots of
235 @Var "fail"@s) is a positively {\em bad} idea, because it makes it
236 impossible to share the default expressions. (Also, it stands no
237 chance of working in our post-upheaval world of @Locals@.)
239 So, the full type signature:
241 match :: [Id] -- Variables rep'ing the exprs we're matching with
242 -> [EquationInfo] -- Info about patterns, etc. (type synonym below)
243 -> DsM MatchResult -- Desugared result!
246 Note: @match@ is often called via @matchWrapper@ (end of this module),
247 a function that does much of the house-keeping that goes with a call
250 It is also worth mentioning the {\em typical} way a block of equations
251 is desugared with @match@. At each stage, it is the first column of
252 patterns that is examined. The steps carried out are roughly:
255 Tidy the patterns in column~1 with @tidyEqnInfo@ (this may add
256 bindings to the second component of the equation-info):
259 Remove the `as' patterns from column~1.
261 Make all constructor patterns in column~1 into @ConPats@, notably
262 @ListPats@ and @TuplePats@.
264 Handle any irrefutable (or ``twiddle'') @LazyPats@.
267 Now {\em unmix} the equations into {\em blocks} [w/ local function
268 @unmix_eqns@], in which the equations in a block all have variable
269 patterns in column~1, or they all have constructor patterns in ...
270 (see ``the mixture rule'' in SLPJ).
272 Call @matchUnmixedEqns@ on each block of equations; it will do the
273 appropriate thing for each kind of column-1 pattern, usually ending up
274 in a recursive call to @match@.
277 %************************************************************************
279 %* match: empty rule *
281 %************************************************************************
282 \subsection[Match-empty-rule]{The ``empty rule''}
284 We are a little more paranoid about the ``empty rule'' (SLPJ, p.~87)
285 than the Wadler-chapter code for @match@ (p.~93, first @match@ clause).
286 And gluing the ``success expressions'' together isn't quite so pretty.
290 = complete_matches eqns_info
292 complete_matches [eqn]
295 complete_matches (eqn:eqns)
296 = complete_match eqn `thenDs` \ match_result1 ->
297 complete_matches eqns `thenDs` \ match_result2 ->
298 returnDs (combineMatchResults match_result1 match_result2)
300 complete_match (EqnInfo _ _ pats match_result)
301 = ASSERT( null pats )
302 returnDs match_result
305 %************************************************************************
307 %* match: non-empty rule *
309 %************************************************************************
310 \subsection[Match-nonempty]{@match@ when non-empty: unmixing}
312 This (more interesting) clause of @match@ uses @tidy_and_unmix_eqns@
313 (a)~to get `as'- and `twiddle'-patterns out of the way (tidying), and
314 (b)~to do ``the mixture rule'' (SLPJ, p.~88) [which really {\em
315 un}mixes the equations], producing a list of equation-info
316 blocks, each block having as its first column of patterns either all
317 constructors, or all variables (or similar beasts), etc.
319 @match_unmixed_eqn_blks@ simply takes the place of the @foldr@ in the
320 Wadler-chapter @match@ (p.~93, last clause), and @match_unmixed_blk@
321 corresponds roughly to @matchVarCon@.
324 match vars@(v:vs) eqns_info
325 = mapDs (tidyEqnInfo v) eqns_info `thenDs` \ tidy_eqns_info ->
327 tidy_eqns_blks = unmix_eqns tidy_eqns_info
329 match_unmixed_eqn_blks vars tidy_eqns_blks
332 unmix_eqns [eqn] = [ [eqn] ]
333 unmix_eqns (eq1@(EqnInfo _ _ (p1:p1s) _) : eq2@(EqnInfo _ _ (p2:p2s) _) : eqs)
334 = if ( (isWildPat p1 && isWildPat p2)
335 || (isConPat p1 && isConPat p2)
336 || (isLitPat p1 && isLitPat p2) ) then
337 eq1 `tack_onto` unmixed_rest
339 [ eq1 ] : unmixed_rest
341 unmixed_rest = unmix_eqns (eq2:eqs)
343 x `tack_onto` xss = ( x : head xss) : tail xss
345 -----------------------------------------------------------------------
346 -- loop through the blocks:
347 -- subsequent blocks create a "fail expr" for the first one...
348 match_unmixed_eqn_blks :: [Id]
349 -> [ [EquationInfo] ] -- List of eqn BLOCKS
352 match_unmixed_eqn_blks vars [] = panic "match_unmixed_eqn_blks"
354 match_unmixed_eqn_blks vars [eqn_blk] = matchUnmixedEqns vars eqn_blk
356 match_unmixed_eqn_blks vars (eqn_blk:eqn_blks)
357 = matchUnmixedEqns vars eqn_blk `thenDs` \ match_result1 -> -- try to match with first blk
358 match_unmixed_eqn_blks vars eqn_blks `thenDs` \ match_result2 ->
359 returnDs (combineMatchResults match_result1 match_result2)
362 Tidy up the leftmost pattern in an @EquationInfo@, given the variable @v@
363 which will be scrutinised. This means:
366 Replace variable patterns @x@ (@x /= v@) with the pattern @_@,
367 together with the binding @x = v@.
369 Replace the `as' pattern @x@@p@ with the pattern p and a binding @x = v@.
371 Removing lazy (irrefutable) patterns (you don't want to know...).
373 Converting explicit tuple- and list-pats into ordinary @ConPats@.
375 Convert the literal pat "" to [].
378 The result of this tidying is that the column of patterns will include
382 The @VarPat@ information isn't needed any more after this.
385 @ListPats@, @TuplePats@, etc., are all converted into @ConPats@.
387 \item[@LitPats@ and @NPats@:]
388 @LitPats@/@NPats@ of ``known friendly types'' (Int, Char,
389 Float, Double, at least) are converted to unboxed form; e.g.,
390 \tr{(NPat (HsInt i) _ _)} is converted to:
392 (ConPat I# _ _ [LitPat (HsIntPrim i) _])
397 tidyEqnInfo :: Id -> EquationInfo -> DsM EquationInfo
398 -- DsM'd because of internal call to "match".
399 -- "tidy1" does the interesting stuff, looking at
400 -- one pattern and fiddling the list of bindings.
402 -- POST CONDITION: head pattern in the EqnInfo is
410 tidyEqnInfo v (EqnInfo n ctx (pat : pats) match_result)
411 = tidy1 v pat match_result `thenDs` \ (pat', match_result') ->
412 returnDs (EqnInfo n ctx (pat' : pats) match_result')
414 tidy1 :: Id -- The Id being scrutinised
415 -> TypecheckedPat -- The pattern against which it is to be matched
416 -> MatchResult -- Current thing do do after matching
417 -> DsM (TypecheckedPat, -- Equivalent pattern
418 MatchResult) -- Augmented thing to do afterwards
419 -- The augmentation usually takes the form
420 -- of new bindings to be added to the front
422 tidy1 v (VarPat var) match_result
423 = returnDs (WildPat (idType var), match_result')
425 match_result' | v == var = match_result
426 | otherwise = adjustMatchResult (bindNonRec var (Var v)) match_result
428 tidy1 v (AsPat var pat) match_result
429 = tidy1 v pat match_result'
431 match_result' | v == var = match_result
432 | otherwise = adjustMatchResult (bindNonRec var (Var v)) match_result
434 tidy1 v (WildPat ty) match_result
435 = returnDs (WildPat ty, match_result)
437 {- now, here we handle lazy patterns:
438 tidy1 v ~p bs = (v, v1 = case v of p -> v1 :
439 v2 = case v of p -> v2 : ... : bs )
441 where the v_i's are the binders in the pattern.
443 ToDo: in "v_i = ... -> v_i", are the v_i's really the same thing?
445 The case expr for v_i is just: match [v] [(p, [], \ x -> Var v_i)] any_expr
448 tidy1 v (LazyPat pat) match_result
449 = mkSelectorBinds pat (Var v) `thenDs` \ sel_binds ->
450 returnDs (WildPat (idType v),
451 mkCoLetsMatchResult [NonRec b rhs | (b,rhs) <- sel_binds] match_result)
453 -- re-express <con-something> as (ConPat ...) [directly]
455 tidy1 v (RecPat data_con pat_ty ex_tvs dicts rpats) match_result
457 = -- Special case for C {}, which can be used for
458 -- a constructor that isn't declared to have
460 returnDs (ConPat data_con pat_ty ex_tvs dicts (map WildPat con_arg_tys'), match_result)
463 = returnDs (ConPat data_con pat_ty ex_tvs dicts pats, match_result)
465 pats = map mk_pat tagged_arg_tys
467 -- Boring stuff to find the arg-tys of the constructor
468 (_, inst_tys, _) = splitAlgTyConApp pat_ty
469 con_arg_tys' = dataConInstOrigArgTys data_con (inst_tys ++ mkTyVarTys ex_tvs)
470 tagged_arg_tys = con_arg_tys' `zip` (dataConFieldLabels data_con)
472 -- mk_pat picks a WildPat of the appropriate type for absent fields,
473 -- and the specified pattern for present fields
474 mk_pat (arg_ty, lbl) = case [pat | (sel_id,pat,_) <- rpats,
475 recordSelectorFieldLabel sel_id == lbl
477 (pat:pats) -> ASSERT( null pats )
481 tidy1 v (ListPat ty pats) match_result
482 = returnDs (list_ConPat, match_result)
484 list_ty = mkListTy ty
486 = foldr (\ x -> \y -> ConPat consDataCon list_ty [] [] [x, y])
487 (ConPat nilDataCon list_ty [] [] [])
490 tidy1 v (TuplePat pats boxity) match_result
491 = returnDs (tuple_ConPat, match_result)
495 = ConPat (tupleCon boxity arity)
496 (mkTupleTy boxity arity (map outPatType pats)) [] []
499 tidy1 v (DictPat dicts methods) match_result
500 = case num_of_d_and_ms of
501 0 -> tidy1 v (TuplePat [] Boxed) match_result
502 1 -> tidy1 v (head dict_and_method_pats) match_result
503 _ -> tidy1 v (TuplePat dict_and_method_pats Boxed) match_result
505 num_of_d_and_ms = length dicts + length methods
506 dict_and_method_pats = map VarPat (dicts ++ methods)
508 -- LitPats: we *might* be able to replace these w/ a simpler form
509 tidy1 v pat@(LitPat lit lit_ty) match_result
510 = returnDs (tidyLitPat lit pat, match_result)
512 -- NPats: we *might* be able to replace these w/ a simpler form
513 tidy1 v pat@(NPat lit lit_ty _) match_result
514 = returnDs (tidyNPat lit lit_ty pat, match_result)
516 -- and everything else goes through unchanged...
518 tidy1 v non_interesting_pat match_result
519 = returnDs (non_interesting_pat, match_result)
523 {\bf Previous @matchTwiddled@ stuff:}
525 Now we get to the only interesting part; note: there are choices for
526 translation [from Simon's notes]; translation~1:
533 s = case w of [s,t] -> s
534 t = case w of [s,t] -> t
538 Here \tr{w} is a fresh variable, and the \tr{w}-binding prevents multiple
539 evaluation of \tr{e}. An alternative translation (No.~2):
541 [ w = case e of [s,t] -> (s,t)
542 s = case w of (s,t) -> s
543 t = case w of (s,t) -> t
547 %************************************************************************
549 \subsubsection[improved-unmixing]{UNIMPLEMENTED idea for improved unmixing}
551 %************************************************************************
553 We might be able to optimise unmixing when confronted by
554 only-one-constructor-possible, of which tuples are the most notable
562 This definition would normally be unmixed into four equation blocks,
563 one per equation. But it could be unmixed into just one equation
564 block, because if the one equation matches (on the first column),
565 the others certainly will.
567 You have to be careful, though; the example
575 {\em must} be broken into two blocks at the line shown; otherwise, you
576 are forcing unnecessary evaluation. In any case, the top-left pattern
577 always gives the cue. You could then unmix blocks into groups of...
579 \item[all variables:]
581 \item[constructors or variables (mixed):]
582 Need to make sure the right names get bound for the variable patterns.
583 \item[literals or variables (mixed):]
584 Presumably just a variant on the constructor case (as it is now).
587 %************************************************************************
589 %* match on an unmixed block: the real business *
591 %************************************************************************
592 \subsection[matchUnmixedEqns]{@matchUnmixedEqns@: getting down to business}
594 The function @matchUnmixedEqns@ is where the matching stuff sets to
595 work a block of equations, to which the mixture rule has been applied.
596 Its arguments and results are the same as for the ``top-level'' @match@.
599 matchUnmixedEqns :: [Id]
603 matchUnmixedEqns [] _ = panic "matchUnmixedEqns: no names"
605 matchUnmixedEqns all_vars@(var:vars) eqns_info
606 | isWildPat first_pat
607 = ASSERT( all isWildPat column_1_pats ) -- Sanity check
608 -- Real true variables, just like in matchVar, SLPJ p 94
609 -- No binding to do: they'll all be wildcards by now (done in tidy)
610 match vars remaining_eqns_info
613 = ASSERT( patsAreAllCons column_1_pats )
614 matchConFamily all_vars eqns_info
617 = ASSERT( patsAreAllLits column_1_pats )
618 -- see notes in MatchLiteral
619 -- not worried about the same literal more than once in a column
620 -- (ToDo: sort this out later)
621 matchLiterals all_vars eqns_info
624 first_pat = head column_1_pats
625 column_1_pats = [pat | EqnInfo _ _ (pat:_) _ <- eqns_info]
626 remaining_eqns_info = [EqnInfo n ctx pats match_result | EqnInfo n ctx (_:pats) match_result <- eqns_info]
629 %************************************************************************
631 %* matchWrapper: a convenient way to call @match@ *
633 %************************************************************************
634 \subsection[matchWrapper]{@matchWrapper@: a convenient interface to @match@}
636 Calls to @match@ often involve similar (non-trivial) work; that work
637 is collected here, in @matchWrapper@. This function takes as
641 Typchecked @Matches@ (of a function definition, or a case or lambda
642 expression)---the main input;
644 An error message to be inserted into any (runtime) pattern-matching
648 As results, @matchWrapper@ produces:
651 A list of variables (@Locals@) that the caller must ``promise'' to
652 bind to appropriate values; and
654 a @CoreExpr@, the desugared output (main result).
657 The main actions of @matchWrapper@ include:
660 Flatten the @[TypecheckedMatch]@ into a suitable list of
663 Create as many new variables as there are patterns in a pattern-list
664 (in any one of the @EquationInfo@s).
666 Create a suitable ``if it fails'' expression---a call to @error@ using
667 the error-string input; the {\em type} of this fail value can be found
668 by examining one of the RHS expressions in one of the @EquationInfo@s.
670 Call @match@ with all of this information!
674 matchWrapper :: DsMatchKind -- For shadowing warning messages
675 -> [TypecheckedMatch] -- Matches being desugared
676 -> String -- Error message if the match fails
677 -> DsM ([Id], CoreExpr) -- Results
680 There is one small problem with the Lambda Patterns, when somebody
681 writes something similar to:
685 he/she don't want a warning about incomplete patterns, that is done with
686 the flag @opt_WarnSimplePatterns@.
687 This problem also appears in the:
689 \item @do@ patterns, but if the @do@ can fail
690 it creates another equation if the match can fail
691 (see @DsExpr.doDo@ function)
692 \item @let@ patterns, are treated by @matchSimply@
693 List Comprension Patterns, are treated by @matchSimply@ also
696 We can't call @matchSimply@ with Lambda patterns,
697 due to the fact that lambda patterns can have more than
698 one pattern, and match simply only accepts one pattern.
703 matchWrapper kind matches error_string
704 = flattenMatches kind matches `thenDs` \ (result_ty, eqns_info) ->
706 EqnInfo _ _ arg_pats _ : _ = eqns_info
708 mapDs selectMatchVar arg_pats `thenDs` \ new_vars ->
709 match_fun new_vars eqns_info `thenDs` \ match_result ->
711 mkErrorAppDs pAT_ERROR_ID result_ty error_string `thenDs` \ fail_expr ->
712 extractMatchResult match_result fail_expr `thenDs` \ result_expr ->
713 returnDs (new_vars, result_expr)
714 where match_fun = case kind of
715 LambdaMatch | opt_WarnSimplePatterns -> matchExport
720 %************************************************************************
722 \subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern}
724 %************************************************************************
726 @mkSimpleMatch@ is a wrapper for @match@ which deals with the
727 situation where we want to match a single expression against a single
728 pattern. It returns an expression.
731 matchSimply :: CoreExpr -- Scrutinee
732 -> DsMatchKind -- Match kind
733 -> TypecheckedPat -- Pattern it should match
734 -> CoreExpr -- Return this if it matches
735 -> CoreExpr -- Return this if it doesn't
738 matchSimply scrut kind pat result_expr fail_expr
739 = getSrcLocDs `thenDs` \ locn ->
741 ctx = DsMatchContext kind [pat] locn
742 match_result = cantFailMatchResult result_expr
744 matchSinglePat scrut ctx pat match_result `thenDs` \ match_result' ->
745 extractMatchResult match_result' fail_expr
748 matchSinglePat :: CoreExpr -> DsMatchContext -> TypecheckedPat
749 -> MatchResult -> DsM MatchResult
751 matchSinglePat (Var var) ctx pat match_result
752 = match_fn [var] [EqnInfo 1 ctx [pat] match_result]
754 match_fn | opt_WarnSimplePatterns = matchExport
757 matchSinglePat scrut ctx pat match_result
758 = selectMatchVar pat `thenDs` \ var ->
759 matchSinglePat (Var var) ctx pat match_result `thenDs` \ match_result' ->
760 returnDs (adjustMatchResult (bindNonRec var scrut) match_result')
763 %************************************************************************
765 %* flattenMatches : create a list of EquationInfo *
767 %************************************************************************
769 \subsection[flattenMatches]{@flattenMatches@: create @[EquationInfo]@}
771 This is actually local to @matchWrapper@.
776 -> [TypecheckedMatch]
777 -> DsM (Type, [EquationInfo])
779 flattenMatches kind matches
780 = mapAndUnzipDs flatten_match (matches `zip` [1..]) `thenDs` \ (result_tys, eqn_infos) ->
782 result_ty = head result_tys
784 ASSERT( all (== result_ty) result_tys )
785 returnDs (result_ty, eqn_infos)
787 flatten_match (Match _ pats _ grhss, n)
788 = dsGRHSs kind pats grhss `thenDs` \ (ty, match_result) ->
789 getSrcLocDs `thenDs` \ locn ->
790 returnDs (ty, EqnInfo n (DsMatchContext kind pats locn) pats match_result)