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, dsLet )
13 import CmdLineOpts ( opt_WarnIncompletePatterns, opt_WarnOverlappingPatterns,
14 opt_WarnSimplePatterns
17 import TcHsSyn ( TypecheckedPat, TypecheckedMatch )
18 import DsHsSyn ( outPatType )
19 import Check ( check, ExhaustivePat )
21 import CoreUtils ( bindNonRec )
23 import DsGRHSs ( dsGRHSs )
25 import Id ( idType, recordSelectorFieldLabel, Id )
26 import DataCon ( dataConFieldLabels, dataConArgTys )
27 import MatchCon ( matchConFamily )
28 import MatchLit ( matchLiterals )
29 import PrelInfo ( pAT_ERROR_ID )
30 import Type ( isUnLiftedType, splitAlgTyConApp,
33 import TysPrim ( intPrimTy, charPrimTy, floatPrimTy, doublePrimTy,
34 addrPrimTy, wordPrimTy
36 import TysWiredIn ( nilDataCon, consDataCon, mkTupleTy, mkListTy,
37 charTy, charDataCon, intTy, intDataCon,
38 floatTy, floatDataCon, doubleTy, tupleCon,
39 doubleDataCon, addrTy,
40 addrDataCon, wordTy, wordDataCon
42 import BasicTypes ( Boxity(..) )
44 import ErrUtils ( addErrLocHdrLine, dontAddErrLoc )
48 This function is a wrapper of @match@, it must be called from all the parts where
49 it was called match, but only substitutes the firs call, ....
50 if the associated flags are declared, warnings will be issued.
51 It can not be called matchWrapper because this name already exists :-(
56 matchExport :: [Id] -- Vars rep'ing the exprs we're matching with
57 -> [EquationInfo] -- Info about patterns, etc. (type synonym below)
58 -> DsM MatchResult -- Desugared result!
60 matchExport vars qs@((EqnInfo _ ctx _ (MatchResult _ _)) : _)
61 | incomplete && shadow =
62 dsShadowWarn ctx eqns_shadow `thenDs` \ () ->
63 dsIncompleteWarn ctx pats `thenDs` \ () ->
66 dsIncompleteWarn ctx pats `thenDs` \ () ->
69 dsShadowWarn ctx eqns_shadow `thenDs` \ () ->
73 where (pats,indexs) = check qs
74 incomplete = opt_WarnIncompletePatterns && (length pats /= 0)
75 shadow = opt_WarnOverlappingPatterns && sizeUniqSet indexs < no_eqns
77 unused_eqns = uniqSetToList (mkUniqSet [1..no_eqns] `minusUniqSet` indexs)
78 eqns_shadow = map (\n -> qs!!(n - 1)) unused_eqns
81 This variable shows the maximum number of lines of output generated for warnings.
82 It will limit the number of patterns/equations displayed to@ maximum_output@.
84 (ToDo: add command-line option?)
90 The next two functions create the warning message.
93 dsShadowWarn :: DsMatchContext -> [EquationInfo] -> DsM ()
94 dsShadowWarn ctx@(DsMatchContext kind _ _) qs = dsWarn warn
96 warn | length qs > maximum_output
97 = pp_context ctx (ptext SLIT("are overlapped"))
98 (\ f -> vcat (map (ppr_eqn f kind) (take maximum_output qs)) $$
101 = pp_context ctx (ptext SLIT("are overlapped"))
102 (\ f -> vcat $ map (ppr_eqn f kind) qs)
105 dsIncompleteWarn :: DsMatchContext -> [ExhaustivePat] -> DsM ()
106 dsIncompleteWarn ctx@(DsMatchContext kind _ _) pats = dsWarn warn
108 warn = pp_context ctx (ptext SLIT("are non-exhaustive"))
109 (\f -> hang (ptext SLIT("Patterns not matched:"))
110 4 ((vcat $ map (ppr_incomplete_pats kind)
111 (take maximum_output pats))
114 dots | length pats > maximum_output = ptext SLIT("...")
117 pp_context NoMatchContext msg rest_of_msg_fun
118 = dontAddErrLoc "" (ptext SLIT("Some match(es)") <+> hang msg 8 (rest_of_msg_fun id))
120 pp_context (DsMatchContext kind pats loc) msg rest_of_msg_fun
121 = case pp_match kind pats of
123 addErrLocHdrLine loc message (nest 8 (rest_of_msg_fun pref))
125 message = ptext SLIT("Pattern match(es)") <+> msg <+> ppr_match <> char ':'
127 pp_match (FunMatch fun) pats
128 = let ppr_fun = ppr fun in
129 ( hsep [ptext SLIT("in the definition of function"), quotes ppr_fun]
130 , (\ x -> ppr_fun <+> x)
133 pp_match CaseMatch pats
134 = (hang (ptext SLIT("in a group of case alternatives beginning"))
139 pp_match RecUpdMatch pats
140 = (hang (ptext SLIT("in a record-update construct"))
145 pp_match PatBindMatch pats
146 = ( hang (ptext SLIT("in a pattern binding"))
151 pp_match LambdaMatch pats
152 = ( hang (ptext SLIT("in a lambda abstraction"))
157 pp_match DoBindMatch pats
158 = ( hang (ptext SLIT("in a `do' pattern binding"))
163 pp_match ListCompMatch pats
164 = ( hang (ptext SLIT("in a `list comprension' pattern binding"))
169 pp_match LetMatch pats
170 = ( hang (ptext SLIT("in a `let' pattern binding"))
175 ppr_pats pats = sep (map ppr pats)
177 separator (FunMatch _) = SLIT("=")
178 separator (CaseMatch) = SLIT("->")
179 separator (LambdaMatch) = SLIT("->")
180 separator (PatBindMatch) = panic "When is this used?"
181 separator (RecUpdMatch) = panic "When is this used?"
182 separator (DoBindMatch) = SLIT("<-")
183 separator (ListCompMatch) = SLIT("<-")
184 separator (LetMatch) = SLIT("=")
186 ppr_shadow_pats kind pats
187 = sep [ppr_pats pats, ptext (separator kind), ptext SLIT("...")]
189 ppr_incomplete_pats kind (pats,[]) = ppr_pats pats
190 ppr_incomplete_pats kind (pats,constraints) =
191 sep [ppr_pats pats, ptext SLIT("with"),
192 sep (map ppr_constraint constraints)]
195 ppr_constraint (var,pats) = sep [ppr var, ptext SLIT("`notElem`"), ppr pats]
197 ppr_eqn prefixF kind (EqnInfo _ _ pats _) = prefixF (ppr_shadow_pats kind pats)
201 The function @match@ is basically the same as in the Wadler chapter,
202 except it is monadised, to carry around the name supply, info about
205 Notes on @match@'s arguments, assuming $m$ equations and $n$ patterns:
208 A list of $n$ variable names, those variables presumably bound to the
209 $n$ expressions being matched against the $n$ patterns. Using the
210 list of $n$ expressions as the first argument showed no benefit and
214 The second argument, a list giving the ``equation info'' for each of
218 the $n$ patterns for that equation, and
220 a list of Core bindings [@(Id, CoreExpr)@ pairs] to be ``stuck on
221 the front'' of the matching code, as in:
227 and finally: (ToDo: fill in)
229 The right way to think about the ``after-match function'' is that it
230 is an embryonic @CoreExpr@ with a ``hole'' at the end for the
231 final ``else expression''.
234 There is a type synonym, @EquationInfo@, defined in module @DsUtils@.
236 An experiment with re-ordering this information about equations (in
237 particular, having the patterns available in column-major order)
241 A default expression---what to evaluate if the overall pattern-match
242 fails. This expression will (almost?) always be
243 a measly expression @Var@, unless we know it will only be used once
244 (as we do in @glue_success_exprs@).
246 Leaving out this third argument to @match@ (and slamming in lots of
247 @Var "fail"@s) is a positively {\em bad} idea, because it makes it
248 impossible to share the default expressions. (Also, it stands no
249 chance of working in our post-upheaval world of @Locals@.)
251 So, the full type signature:
253 match :: [Id] -- Variables rep'ing the exprs we're matching with
254 -> [EquationInfo] -- Info about patterns, etc. (type synonym below)
255 -> DsM MatchResult -- Desugared result!
258 Note: @match@ is often called via @matchWrapper@ (end of this module),
259 a function that does much of the house-keeping that goes with a call
262 It is also worth mentioning the {\em typical} way a block of equations
263 is desugared with @match@. At each stage, it is the first column of
264 patterns that is examined. The steps carried out are roughly:
267 Tidy the patterns in column~1 with @tidyEqnInfo@ (this may add
268 bindings to the second component of the equation-info):
271 Remove the `as' patterns from column~1.
273 Make all constructor patterns in column~1 into @ConPats@, notably
274 @ListPats@ and @TuplePats@.
276 Handle any irrefutable (or ``twiddle'') @LazyPats@.
279 Now {\em unmix} the equations into {\em blocks} [w/ local function
280 @unmix_eqns@], in which the equations in a block all have variable
281 patterns in column~1, or they all have constructor patterns in ...
282 (see ``the mixture rule'' in SLPJ).
284 Call @matchUnmixedEqns@ on each block of equations; it will do the
285 appropriate thing for each kind of column-1 pattern, usually ending up
286 in a recursive call to @match@.
289 %************************************************************************
291 %* match: empty rule *
293 %************************************************************************
294 \subsection[Match-empty-rule]{The ``empty rule''}
296 We are a little more paranoid about the ``empty rule'' (SLPJ, p.~87)
297 than the Wadler-chapter code for @match@ (p.~93, first @match@ clause).
298 And gluing the ``success expressions'' together isn't quite so pretty.
302 = complete_matches eqns_info
304 complete_matches [eqn]
307 complete_matches (eqn:eqns)
308 = complete_match eqn `thenDs` \ match_result1 ->
309 complete_matches eqns `thenDs` \ match_result2 ->
310 returnDs (combineMatchResults match_result1 match_result2)
312 complete_match (EqnInfo _ _ pats match_result)
313 = ASSERT( null pats )
314 returnDs match_result
317 %************************************************************************
319 %* match: non-empty rule *
321 %************************************************************************
322 \subsection[Match-nonempty]{@match@ when non-empty: unmixing}
324 This (more interesting) clause of @match@ uses @tidy_and_unmix_eqns@
325 (a)~to get `as'- and `twiddle'-patterns out of the way (tidying), and
326 (b)~to do ``the mixture rule'' (SLPJ, p.~88) [which really {\em
327 un}mixes the equations], producing a list of equation-info
328 blocks, each block having as its first column of patterns either all
329 constructors, or all variables (or similar beasts), etc.
331 @match_unmixed_eqn_blks@ simply takes the place of the @foldr@ in the
332 Wadler-chapter @match@ (p.~93, last clause), and @match_unmixed_blk@
333 corresponds roughly to @matchVarCon@.
336 match vars@(v:vs) eqns_info
337 = mapDs (tidyEqnInfo v) eqns_info `thenDs` \ tidy_eqns_info ->
339 tidy_eqns_blks = unmix_eqns tidy_eqns_info
341 match_unmixed_eqn_blks vars tidy_eqns_blks
344 unmix_eqns [eqn] = [ [eqn] ]
345 unmix_eqns (eq1@(EqnInfo _ _ (p1:p1s) _) : eq2@(EqnInfo _ _ (p2:p2s) _) : eqs)
346 = if ( (isWildPat p1 && isWildPat p2)
347 || (isConPat p1 && isConPat p2)
348 || (isLitPat p1 && isLitPat p2) ) then
349 eq1 `tack_onto` unmixed_rest
351 [ eq1 ] : unmixed_rest
353 unmixed_rest = unmix_eqns (eq2:eqs)
355 x `tack_onto` xss = ( x : head xss) : tail xss
357 -----------------------------------------------------------------------
358 -- loop through the blocks:
359 -- subsequent blocks create a "fail expr" for the first one...
360 match_unmixed_eqn_blks :: [Id]
361 -> [ [EquationInfo] ] -- List of eqn BLOCKS
364 match_unmixed_eqn_blks vars [] = panic "match_unmixed_eqn_blks"
366 match_unmixed_eqn_blks vars [eqn_blk] = matchUnmixedEqns vars eqn_blk
368 match_unmixed_eqn_blks vars (eqn_blk:eqn_blks)
369 = matchUnmixedEqns vars eqn_blk `thenDs` \ match_result1 -> -- try to match with first blk
370 match_unmixed_eqn_blks vars eqn_blks `thenDs` \ match_result2 ->
371 returnDs (combineMatchResults match_result1 match_result2)
374 Tidy up the leftmost pattern in an @EquationInfo@, given the variable @v@
375 which will be scrutinised. This means:
378 Replace variable patterns @x@ (@x /= v@) with the pattern @_@,
379 together with the binding @x = v@.
381 Replace the `as' pattern @x@@p@ with the pattern p and a binding @x = v@.
383 Removing lazy (irrefutable) patterns (you don't want to know...).
385 Converting explicit tuple- and list-pats into ordinary @ConPats@.
387 Convert the literal pat "" to [].
390 The result of this tidying is that the column of patterns will include
394 The @VarPat@ information isn't needed any more after this.
397 @ListPats@, @TuplePats@, etc., are all converted into @ConPats@.
399 \item[@LitPats@ and @NPats@:]
400 @LitPats@/@NPats@ of ``known friendly types'' (Int, Char,
401 Float, Double, at least) are converted to unboxed form; e.g.,
402 \tr{(NPat (HsInt i) _ _)} is converted to:
404 (ConPat I# _ _ [LitPat (HsIntPrim i) _])
409 tidyEqnInfo :: Id -> EquationInfo -> DsM EquationInfo
410 -- DsM'd because of internal call to "match".
411 -- "tidy1" does the interesting stuff, looking at
412 -- one pattern and fiddling the list of bindings.
414 -- POST CONDITION: head pattern in the EqnInfo is
422 tidyEqnInfo v (EqnInfo n ctx (pat : pats) match_result)
423 = tidy1 v pat match_result `thenDs` \ (pat', match_result') ->
424 returnDs (EqnInfo n ctx (pat' : pats) match_result')
426 tidy1 :: Id -- The Id being scrutinised
427 -> TypecheckedPat -- The pattern against which it is to be matched
428 -> MatchResult -- Current thing do do after matching
429 -> DsM (TypecheckedPat, -- Equivalent pattern
430 MatchResult) -- Augmented thing to do afterwards
431 -- The augmentation usually takes the form
432 -- of new bindings to be added to the front
434 tidy1 v (VarPat var) match_result
435 = returnDs (WildPat (idType var), match_result')
437 match_result' | v == var = match_result
438 | otherwise = adjustMatchResult (bindNonRec var (Var v)) match_result
440 tidy1 v (AsPat var pat) match_result
441 = tidy1 v pat match_result'
443 match_result' | v == var = match_result
444 | otherwise = adjustMatchResult (bindNonRec var (Var v)) match_result
446 tidy1 v (WildPat ty) match_result
447 = returnDs (WildPat ty, match_result)
449 {- now, here we handle lazy patterns:
450 tidy1 v ~p bs = (v, v1 = case v of p -> v1 :
451 v2 = case v of p -> v2 : ... : bs )
453 where the v_i's are the binders in the pattern.
455 ToDo: in "v_i = ... -> v_i", are the v_i's really the same thing?
457 The case expr for v_i is just: match [v] [(p, [], \ x -> Var v_i)] any_expr
460 tidy1 v (LazyPat pat) match_result
461 = mkSelectorBinds pat (Var v) `thenDs` \ sel_binds ->
462 returnDs (WildPat (idType v),
463 mkCoLetsMatchResult [NonRec b rhs | (b,rhs) <- sel_binds] match_result)
465 -- re-express <con-something> as (ConPat ...) [directly]
467 tidy1 v (RecPat data_con pat_ty ex_tvs dicts rpats) match_result
469 = -- Special case for C {}, which can be used for
470 -- a constructor that isn't declared to have
472 returnDs (ConPat data_con pat_ty ex_tvs dicts (map WildPat con_arg_tys'), match_result)
475 = returnDs (ConPat data_con pat_ty ex_tvs dicts pats, match_result)
477 pats = map mk_pat tagged_arg_tys
479 -- Boring stuff to find the arg-tys of the constructor
480 (_, inst_tys, _) = splitAlgTyConApp pat_ty
481 con_arg_tys' = dataConArgTys data_con (inst_tys ++ mkTyVarTys ex_tvs)
482 tagged_arg_tys = con_arg_tys' `zip` (dataConFieldLabels data_con)
484 -- mk_pat picks a WildPat of the appropriate type for absent fields,
485 -- and the specified pattern for present fields
486 mk_pat (arg_ty, lbl) = case [pat | (sel_id,pat,_) <- rpats,
487 recordSelectorFieldLabel sel_id == lbl
489 (pat:pats) -> ASSERT( null pats )
493 tidy1 v (ListPat ty pats) match_result
494 = returnDs (list_ConPat, match_result)
496 list_ty = mkListTy ty
498 = foldr (\ x -> \y -> ConPat consDataCon list_ty [] [] [x, y])
499 (ConPat nilDataCon list_ty [] [] [])
502 tidy1 v (TuplePat pats boxity) match_result
503 = returnDs (tuple_ConPat, match_result)
507 = ConPat (tupleCon boxity arity)
508 (mkTupleTy boxity arity (map outPatType pats)) [] []
511 tidy1 v (DictPat dicts methods) match_result
512 = case num_of_d_and_ms of
513 0 -> tidy1 v (TuplePat [] Boxed) match_result
514 1 -> tidy1 v (head dict_and_method_pats) match_result
515 _ -> tidy1 v (TuplePat dict_and_method_pats Boxed) match_result
517 num_of_d_and_ms = length dicts + length methods
518 dict_and_method_pats = map VarPat (dicts ++ methods)
521 -- deeply ugly mangling for some (common) NPats/LitPats
523 -- LitPats: the desugarer only sees these at well-known types
525 tidy1 v pat@(LitPat lit lit_ty) match_result
526 = returnDs (tidyLitPat lit lit_ty pat, match_result)
528 -- NPats: we *might* be able to replace these w/ a simpler form
529 tidy1 v pat@(NPat lit lit_ty _) match_result
530 = returnDs (tidyLitPat lit lit_ty pat, match_result)
532 -- and everything else goes through unchanged...
534 tidy1 v non_interesting_pat match_result
535 = returnDs (non_interesting_pat, match_result)
539 {\bf Previous @matchTwiddled@ stuff:}
541 Now we get to the only interesting part; note: there are choices for
542 translation [from Simon's notes]; translation~1:
549 s = case w of [s,t] -> s
550 t = case w of [s,t] -> t
554 Here \tr{w} is a fresh variable, and the \tr{w}-binding prevents multiple
555 evaluation of \tr{e}. An alternative translation (No.~2):
557 [ w = case e of [s,t] -> (s,t)
558 s = case w of (s,t) -> s
559 t = case w of (s,t) -> t
563 %************************************************************************
565 \subsubsection[improved-unmixing]{UNIMPLEMENTED idea for improved unmixing}
567 %************************************************************************
569 We might be able to optimise unmixing when confronted by
570 only-one-constructor-possible, of which tuples are the most notable
578 This definition would normally be unmixed into four equation blocks,
579 one per equation. But it could be unmixed into just one equation
580 block, because if the one equation matches (on the first column),
581 the others certainly will.
583 You have to be careful, though; the example
591 {\em must} be broken into two blocks at the line shown; otherwise, you
592 are forcing unnecessary evaluation. In any case, the top-left pattern
593 always gives the cue. You could then unmix blocks into groups of...
595 \item[all variables:]
597 \item[constructors or variables (mixed):]
598 Need to make sure the right names get bound for the variable patterns.
599 \item[literals or variables (mixed):]
600 Presumably just a variant on the constructor case (as it is now).
603 %************************************************************************
605 %* match on an unmixed block: the real business *
607 %************************************************************************
608 \subsection[matchUnmixedEqns]{@matchUnmixedEqns@: getting down to business}
610 The function @matchUnmixedEqns@ is where the matching stuff sets to
611 work a block of equations, to which the mixture rule has been applied.
612 Its arguments and results are the same as for the ``top-level'' @match@.
615 matchUnmixedEqns :: [Id]
619 matchUnmixedEqns [] _ = panic "matchUnmixedEqns: no names"
621 matchUnmixedEqns all_vars@(var:vars) eqns_info
622 | isWildPat first_pat
623 = ASSERT( all isWildPat column_1_pats ) -- Sanity check
624 -- Real true variables, just like in matchVar, SLPJ p 94
625 -- No binding to do: they'll all be wildcards by now (done in tidy)
626 match vars remaining_eqns_info
629 = ASSERT( patsAreAllCons column_1_pats )
630 matchConFamily all_vars eqns_info
633 = ASSERT( patsAreAllLits column_1_pats )
634 -- see notes in MatchLiteral
635 -- not worried about the same literal more than once in a column
636 -- (ToDo: sort this out later)
637 matchLiterals all_vars eqns_info
640 first_pat = head column_1_pats
641 column_1_pats = [pat | EqnInfo _ _ (pat:_) _ <- eqns_info]
642 remaining_eqns_info = [EqnInfo n ctx pats match_result | EqnInfo n ctx (_:pats) match_result <- eqns_info]
645 %************************************************************************
647 %* matchWrapper: a convenient way to call @match@ *
649 %************************************************************************
650 \subsection[matchWrapper]{@matchWrapper@: a convenient interface to @match@}
652 Calls to @match@ often involve similar (non-trivial) work; that work
653 is collected here, in @matchWrapper@. This function takes as
657 Typchecked @Matches@ (of a function definition, or a case or lambda
658 expression)---the main input;
660 An error message to be inserted into any (runtime) pattern-matching
664 As results, @matchWrapper@ produces:
667 A list of variables (@Locals@) that the caller must ``promise'' to
668 bind to appropriate values; and
670 a @CoreExpr@, the desugared output (main result).
673 The main actions of @matchWrapper@ include:
676 Flatten the @[TypecheckedMatch]@ into a suitable list of
679 Create as many new variables as there are patterns in a pattern-list
680 (in any one of the @EquationInfo@s).
682 Create a suitable ``if it fails'' expression---a call to @error@ using
683 the error-string input; the {\em type} of this fail value can be found
684 by examining one of the RHS expressions in one of the @EquationInfo@s.
686 Call @match@ with all of this information!
690 matchWrapper :: DsMatchKind -- For shadowing warning messages
691 -> [TypecheckedMatch] -- Matches being desugared
692 -> String -- Error message if the match fails
693 -> DsM ([Id], CoreExpr) -- Results
696 There is one small problem with the Lambda Patterns, when somebody
697 writes something similar to:
701 he/she don't want a warning about incomplete patterns, that is done with
702 the flag @opt_WarnSimplePatterns@.
703 This problem also appears in the:
705 \item @do@ patterns, but if the @do@ can fail
706 it creates another equation if the match can fail
707 (see @DsExpr.doDo@ function)
708 \item @let@ patterns, are treated by @matchSimply@
709 List Comprension Patterns, are treated by @matchSimply@ also
712 We can't call @matchSimply@ with Lambda patterns,
713 due to the fact that lambda patterns can have more than
714 one pattern, and match simply only accepts one pattern.
719 matchWrapper kind matches error_string
720 = flattenMatches kind matches `thenDs` \ (result_ty, eqns_info) ->
722 EqnInfo _ _ arg_pats _ : _ = eqns_info
724 mapDs selectMatchVar arg_pats `thenDs` \ new_vars ->
725 match_fun new_vars eqns_info `thenDs` \ match_result ->
727 mkErrorAppDs pAT_ERROR_ID result_ty error_string `thenDs` \ fail_expr ->
728 extractMatchResult match_result fail_expr `thenDs` \ result_expr ->
729 returnDs (new_vars, result_expr)
730 where match_fun = case kind of
731 LambdaMatch | opt_WarnSimplePatterns -> matchExport
736 %************************************************************************
738 \subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern}
740 %************************************************************************
742 @mkSimpleMatch@ is a wrapper for @match@ which deals with the
743 situation where we want to match a single expression against a single
744 pattern. It returns an expression.
747 matchSimply :: CoreExpr -- Scrutinee
748 -> DsMatchKind -- Match kind
749 -> TypecheckedPat -- Pattern it should match
750 -> CoreExpr -- Return this if it matches
751 -> CoreExpr -- Return this if it doesn't
754 matchSimply scrut kind pat result_expr fail_expr
755 = getSrcLocDs `thenDs` \ locn ->
757 ctx = DsMatchContext kind [pat] locn
758 match_result = cantFailMatchResult result_expr
760 matchSinglePat scrut ctx pat match_result `thenDs` \ match_result' ->
761 extractMatchResult match_result' fail_expr
764 matchSinglePat :: CoreExpr -> DsMatchContext -> TypecheckedPat
765 -> MatchResult -> DsM MatchResult
767 matchSinglePat (Var var) ctx pat match_result
768 = match_fn [var] [EqnInfo 1 ctx [pat] match_result]
770 match_fn | opt_WarnSimplePatterns = matchExport
773 matchSinglePat scrut ctx pat match_result
774 = selectMatchVar pat `thenDs` \ var ->
775 matchSinglePat (Var var) ctx pat match_result `thenDs` \ match_result' ->
776 returnDs (adjustMatchResult (bindNonRec var scrut) match_result')
779 %************************************************************************
781 %* flattenMatches : create a list of EquationInfo *
783 %************************************************************************
785 \subsection[flattenMatches]{@flattenMatches@: create @[EquationInfo]@}
787 This is actually local to @matchWrapper@.
792 -> [TypecheckedMatch]
793 -> DsM (Type, [EquationInfo])
795 flattenMatches kind matches
796 = mapAndUnzipDs flatten_match (matches `zip` [1..]) `thenDs` \ (result_tys, eqn_infos) ->
798 result_ty = head result_tys
800 ASSERT( all (== result_ty) result_tys )
801 returnDs (result_ty, eqn_infos)
803 flatten_match (Match _ pats _ grhss, n)
804 = dsGRHSs kind pats grhss `thenDs` \ (ty, match_result) ->
805 getSrcLocDs `thenDs` \ locn ->
806 returnDs (ty, EqnInfo n (DsMatchContext kind pats locn) pats match_result)