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 ( coreExprType )
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,
41 mkUnboxedTupleTy, unboxedTupleCon
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 PatBindMatch pats
140 = ( hang (ptext SLIT("in a pattern binding"))
145 pp_match LambdaMatch pats
146 = ( hang (ptext SLIT("in a lambda abstraction"))
151 pp_match DoBindMatch pats
152 = ( hang (ptext SLIT("in a `do' pattern binding"))
157 pp_match ListCompMatch pats
158 = ( hang (ptext SLIT("in a `list comprension' pattern binding"))
163 pp_match LetMatch pats
164 = ( hang (ptext SLIT("in a `let' pattern binding"))
169 ppr_pats pats = sep (map ppr pats)
171 separator (FunMatch _) = SLIT("=")
172 separator (CaseMatch) = SLIT("->")
173 separator (LambdaMatch) = SLIT("->")
174 separator (PatBindMatch) = panic "When is this used?"
175 separator (DoBindMatch) = SLIT("<-")
176 separator (ListCompMatch) = SLIT("<-")
177 separator (LetMatch) = SLIT("=")
179 ppr_shadow_pats kind pats
180 = sep [ppr_pats pats, ptext (separator kind), ptext SLIT("...")]
182 ppr_incomplete_pats kind (pats,[]) = ppr_pats pats
183 ppr_incomplete_pats kind (pats,constraints) =
184 sep [ppr_pats pats, ptext SLIT("with"),
185 sep (map ppr_constraint constraints)]
188 ppr_constraint (var,pats) = sep [ppr var, ptext SLIT("`not_elem`"), ppr pats]
190 ppr_eqn prefixF kind (EqnInfo _ _ pats _) = prefixF (ppr_shadow_pats kind pats)
194 The function @match@ is basically the same as in the Wadler chapter,
195 except it is monadised, to carry around the name supply, info about
198 Notes on @match@'s arguments, assuming $m$ equations and $n$ patterns:
201 A list of $n$ variable names, those variables presumably bound to the
202 $n$ expressions being matched against the $n$ patterns. Using the
203 list of $n$ expressions as the first argument showed no benefit and
207 The second argument, a list giving the ``equation info'' for each of
211 the $n$ patterns for that equation, and
213 a list of Core bindings [@(Id, CoreExpr)@ pairs] to be ``stuck on
214 the front'' of the matching code, as in:
220 and finally: (ToDo: fill in)
222 The right way to think about the ``after-match function'' is that it
223 is an embryonic @CoreExpr@ with a ``hole'' at the end for the
224 final ``else expression''.
227 There is a type synonym, @EquationInfo@, defined in module @DsUtils@.
229 An experiment with re-ordering this information about equations (in
230 particular, having the patterns available in column-major order)
234 A default expression---what to evaluate if the overall pattern-match
235 fails. This expression will (almost?) always be
236 a measly expression @Var@, unless we know it will only be used once
237 (as we do in @glue_success_exprs@).
239 Leaving out this third argument to @match@ (and slamming in lots of
240 @Var "fail"@s) is a positively {\em bad} idea, because it makes it
241 impossible to share the default expressions. (Also, it stands no
242 chance of working in our post-upheaval world of @Locals@.)
244 So, the full type signature:
246 match :: [Id] -- Variables rep'ing the exprs we're matching with
247 -> [EquationInfo] -- Info about patterns, etc. (type synonym below)
248 -> DsM MatchResult -- Desugared result!
251 Note: @match@ is often called via @matchWrapper@ (end of this module),
252 a function that does much of the house-keeping that goes with a call
255 It is also worth mentioning the {\em typical} way a block of equations
256 is desugared with @match@. At each stage, it is the first column of
257 patterns that is examined. The steps carried out are roughly:
260 Tidy the patterns in column~1 with @tidyEqnInfo@ (this may add
261 bindings to the second component of the equation-info):
264 Remove the `as' patterns from column~1.
266 Make all constructor patterns in column~1 into @ConPats@, notably
267 @ListPats@ and @TuplePats@.
269 Handle any irrefutable (or ``twiddle'') @LazyPats@.
272 Now {\em unmix} the equations into {\em blocks} [w/ local function
273 @unmix_eqns@], in which the equations in a block all have variable
274 patterns in column~1, or they all have constructor patterns in ...
275 (see ``the mixture rule'' in SLPJ).
277 Call @matchUnmixedEqns@ on each block of equations; it will do the
278 appropriate thing for each kind of column-1 pattern, usually ending up
279 in a recursive call to @match@.
282 %************************************************************************
284 %* match: empty rule *
286 %************************************************************************
287 \subsection[Match-empty-rule]{The ``empty rule''}
289 We are a little more paranoid about the ``empty rule'' (SLPJ, p.~87)
290 than the Wadler-chapter code for @match@ (p.~93, first @match@ clause).
291 And gluing the ``success expressions'' together isn't quite so pretty.
295 = complete_matches eqns_info
297 complete_matches [eqn]
300 complete_matches (eqn:eqns)
301 = complete_match eqn `thenDs` \ match_result1 ->
302 complete_matches eqns `thenDs` \ match_result2 ->
303 returnDs (combineMatchResults match_result1 match_result2)
305 complete_match (EqnInfo _ _ pats match_result)
306 = ASSERT( null pats )
307 returnDs match_result
310 %************************************************************************
312 %* match: non-empty rule *
314 %************************************************************************
315 \subsection[Match-nonempty]{@match@ when non-empty: unmixing}
317 This (more interesting) clause of @match@ uses @tidy_and_unmix_eqns@
318 (a)~to get `as'- and `twiddle'-patterns out of the way (tidying), and
319 (b)~to do ``the mixture rule'' (SLPJ, p.~88) [which really {\em
320 un}mixes the equations], producing a list of equation-info
321 blocks, each block having as its first column of patterns either all
322 constructors, or all variables (or similar beasts), etc.
324 @match_unmixed_eqn_blks@ simply takes the place of the @foldr@ in the
325 Wadler-chapter @match@ (p.~93, last clause), and @match_unmixed_blk@
326 corresponds roughly to @matchVarCon@.
329 match vars@(v:vs) eqns_info
330 = mapDs (tidyEqnInfo v) eqns_info `thenDs` \ tidy_eqns_info ->
332 tidy_eqns_blks = unmix_eqns tidy_eqns_info
334 match_unmixed_eqn_blks vars tidy_eqns_blks
337 unmix_eqns [eqn] = [ [eqn] ]
338 unmix_eqns (eq1@(EqnInfo _ _ (p1:p1s) _) : eq2@(EqnInfo _ _ (p2:p2s) _) : eqs)
339 = if ( (isWildPat p1 && isWildPat p2)
340 || (isConPat p1 && isConPat p2)
341 || (isLitPat p1 && isLitPat p2) ) then
342 eq1 `tack_onto` unmixed_rest
344 [ eq1 ] : unmixed_rest
346 unmixed_rest = unmix_eqns (eq2:eqs)
348 x `tack_onto` xss = ( x : head xss) : tail xss
350 -----------------------------------------------------------------------
351 -- loop through the blocks:
352 -- subsequent blocks create a "fail expr" for the first one...
353 match_unmixed_eqn_blks :: [Id]
354 -> [ [EquationInfo] ] -- List of eqn BLOCKS
357 match_unmixed_eqn_blks vars [] = panic "match_unmixed_eqn_blks"
359 match_unmixed_eqn_blks vars [eqn_blk] = matchUnmixedEqns vars eqn_blk
361 match_unmixed_eqn_blks vars (eqn_blk:eqn_blks)
362 = matchUnmixedEqns vars eqn_blk `thenDs` \ match_result1 -> -- try to match with first blk
363 match_unmixed_eqn_blks vars eqn_blks `thenDs` \ match_result2 ->
364 returnDs (combineMatchResults match_result1 match_result2)
367 Tidy up the leftmost pattern in an @EquationInfo@, given the variable @v@
368 which will be scrutinised. This means:
371 Replace variable patterns @x@ (@x /= v@) with the pattern @_@,
372 together with the binding @x = v@.
374 Replace the `as' pattern @x@@p@ with the pattern p and a binding @x = v@.
376 Removing lazy (irrefutable) patterns (you don't want to know...).
378 Converting explicit tuple- and list-pats into ordinary @ConPats@.
380 Convert the literal pat "" to [].
383 The result of this tidying is that the column of patterns will include
387 The @VarPat@ information isn't needed any more after this.
390 @ListPats@, @TuplePats@, etc., are all converted into @ConPats@.
392 \item[@LitPats@ and @NPats@:]
393 @LitPats@/@NPats@ of ``known friendly types'' (Int, Char,
394 Float, Double, at least) are converted to unboxed form; e.g.,
395 \tr{(NPat (HsInt i) _ _)} is converted to:
397 (ConPat I# _ _ [LitPat (HsIntPrim i) _])
402 tidyEqnInfo :: Id -> EquationInfo -> DsM EquationInfo
403 -- DsM'd because of internal call to "match".
404 -- "tidy1" does the interesting stuff, looking at
405 -- one pattern and fiddling the list of bindings.
407 -- POST CONDITION: head pattern in the EqnInfo is
415 tidyEqnInfo v (EqnInfo n ctx (pat : pats) match_result)
416 = tidy1 v pat match_result `thenDs` \ (pat', match_result') ->
417 returnDs (EqnInfo n ctx (pat' : pats) match_result')
419 tidy1 :: Id -- The Id being scrutinised
420 -> TypecheckedPat -- The pattern against which it is to be matched
421 -> MatchResult -- Current thing do do after matching
422 -> DsM (TypecheckedPat, -- Equivalent pattern
423 MatchResult) -- Augmented thing to do afterwards
424 -- The augmentation usually takes the form
425 -- of new bindings to be added to the front
427 tidy1 v (VarPat var) match_result
428 = returnDs (WildPat (idType var), match_result')
430 match_result' | v == var = match_result
431 | otherwise = adjustMatchResult (bindNonRec var (Var v)) match_result
433 tidy1 v (AsPat var pat) match_result
434 = tidy1 v pat match_result'
436 match_result' | v == var = match_result
437 | otherwise = adjustMatchResult (bindNonRec var (Var v)) match_result
439 tidy1 v (WildPat ty) match_result
440 = returnDs (WildPat ty, match_result)
442 {- now, here we handle lazy patterns:
443 tidy1 v ~p bs = (v, v1 = case v of p -> v1 :
444 v2 = case v of p -> v2 : ... : bs )
446 where the v_i's are the binders in the pattern.
448 ToDo: in "v_i = ... -> v_i", are the v_i's really the same thing?
450 The case expr for v_i is just: match [v] [(p, [], \ x -> Var v_i)] any_expr
453 tidy1 v (LazyPat pat) match_result
454 = mkSelectorBinds pat (Var v) `thenDs` \ sel_binds ->
455 returnDs (WildPat (idType v),
456 mkCoLetsMatchResult [NonRec b rhs | (b,rhs) <- sel_binds] match_result)
458 -- re-express <con-something> as (ConPat ...) [directly]
460 tidy1 v (RecPat data_con pat_ty ex_tvs dicts rpats) match_result
462 = -- Special case for C {}, which can be used for
463 -- a constructor that isn't declared to have
465 returnDs (ConPat data_con pat_ty ex_tvs dicts (map WildPat con_arg_tys'), match_result)
468 = returnDs (ConPat data_con pat_ty ex_tvs dicts pats, match_result)
470 pats = map mk_pat tagged_arg_tys
472 -- Boring stuff to find the arg-tys of the constructor
473 (_, inst_tys, _) = splitAlgTyConApp pat_ty
474 con_arg_tys' = dataConArgTys data_con (inst_tys ++ mkTyVarTys ex_tvs)
475 tagged_arg_tys = con_arg_tys' `zip` (dataConFieldLabels data_con)
477 -- mk_pat picks a WildPat of the appropriate type for absent fields,
478 -- and the specified pattern for present fields
479 mk_pat (arg_ty, lbl) = case [pat | (sel_id,pat,_) <- rpats,
480 recordSelectorFieldLabel sel_id == lbl
482 (pat:pats) -> ASSERT( null pats )
486 tidy1 v (ListPat ty pats) match_result
487 = returnDs (list_ConPat, match_result)
489 list_ty = mkListTy ty
491 = foldr (\ x -> \y -> ConPat consDataCon list_ty [] [] [x, y])
492 (ConPat nilDataCon list_ty [] [] [])
495 tidy1 v (TuplePat pats True{-boxed-}) match_result
496 = returnDs (tuple_ConPat, match_result)
500 = ConPat (tupleCon arity)
501 (mkTupleTy arity (map outPatType pats)) [] []
504 tidy1 v (TuplePat pats False{-unboxed-}) match_result
505 = returnDs (tuple_ConPat, match_result)
509 = ConPat (unboxedTupleCon arity)
510 (mkUnboxedTupleTy arity (map outPatType pats)) [] []
513 tidy1 v (DictPat dicts methods) match_result
514 = case num_of_d_and_ms of
515 0 -> tidy1 v (TuplePat [] True) match_result
516 1 -> tidy1 v (head dict_and_method_pats) match_result
517 _ -> tidy1 v (TuplePat dict_and_method_pats True) match_result
519 num_of_d_and_ms = length dicts + length methods
520 dict_and_method_pats = map VarPat (dicts ++ methods)
523 -- deeply ugly mangling for some (common) NPats/LitPats
525 -- LitPats: the desugarer only sees these at well-known types
527 tidy1 v pat@(LitPat lit lit_ty) match_result
528 | isUnLiftedType lit_ty
529 = returnDs (pat, match_result)
532 = returnDs (ConPat charDataCon charTy [] [] [LitPat (mk_char lit) charPrimTy],
535 | otherwise = pprPanic "tidy1:LitPat:" (ppr pat)
537 mk_char (HsChar c) = HsCharPrim c
539 -- NPats: we *might* be able to replace these w/ a simpler form
542 tidy1 v pat@(NPat lit lit_ty _) match_result
543 = returnDs (better_pat, match_result)
546 | lit_ty == charTy = ConPat charDataCon lit_ty [] [] [LitPat (mk_char lit) charPrimTy]
547 | lit_ty == intTy = ConPat intDataCon lit_ty [] [] [LitPat (mk_int lit) intPrimTy]
548 | lit_ty == wordTy = ConPat wordDataCon lit_ty [] [] [LitPat (mk_word lit) wordPrimTy]
549 | lit_ty == addrTy = ConPat addrDataCon lit_ty [] [] [LitPat (mk_addr lit) addrPrimTy]
550 | lit_ty == floatTy = ConPat floatDataCon lit_ty [] [] [LitPat (mk_float lit) floatPrimTy]
551 | lit_ty == doubleTy = ConPat doubleDataCon lit_ty [] [] [LitPat (mk_double lit) doublePrimTy]
553 -- Convert the literal pattern "" to the constructor pattern [].
554 | null_str_lit lit = ConPat nilDataCon lit_ty [] [] []
558 mk_int (HsInt i) = HsIntPrim i
559 mk_int l@(HsLitLit s) = l
561 mk_char (HsChar c) = HsCharPrim c
562 mk_char l@(HsLitLit s) = l
564 mk_word l@(HsLitLit s) = l
566 mk_addr l@(HsLitLit s) = l
568 mk_float (HsInt i) = HsFloatPrim (fromInteger i)
569 mk_float (HsFrac f) = HsFloatPrim f
570 mk_float l@(HsLitLit s) = l
572 mk_double (HsInt i) = HsDoublePrim (fromInteger i)
573 mk_double (HsFrac f) = HsDoublePrim f
574 mk_double l@(HsLitLit s) = l
576 null_str_lit (HsString s) = _NULL_ s
577 null_str_lit other_lit = False
579 -- and everything else goes through unchanged...
581 tidy1 v non_interesting_pat match_result
582 = returnDs (non_interesting_pat, match_result)
586 {\bf Previous @matchTwiddled@ stuff:}
588 Now we get to the only interesting part; note: there are choices for
589 translation [from Simon's notes]; translation~1:
596 s = case w of [s,t] -> s
597 t = case w of [s,t] -> t
601 Here \tr{w} is a fresh variable, and the \tr{w}-binding prevents multiple
602 evaluation of \tr{e}. An alternative translation (No.~2):
604 [ w = case e of [s,t] -> (s,t)
605 s = case w of (s,t) -> s
606 t = case w of (s,t) -> t
610 %************************************************************************
612 \subsubsection[improved-unmixing]{UNIMPLEMENTED idea for improved unmixing}
614 %************************************************************************
616 We might be able to optimise unmixing when confronted by
617 only-one-constructor-possible, of which tuples are the most notable
625 This definition would normally be unmixed into four equation blocks,
626 one per equation. But it could be unmixed into just one equation
627 block, because if the one equation matches (on the first column),
628 the others certainly will.
630 You have to be careful, though; the example
638 {\em must} be broken into two blocks at the line shown; otherwise, you
639 are forcing unnecessary evaluation. In any case, the top-left pattern
640 always gives the cue. You could then unmix blocks into groups of...
642 \item[all variables:]
644 \item[constructors or variables (mixed):]
645 Need to make sure the right names get bound for the variable patterns.
646 \item[literals or variables (mixed):]
647 Presumably just a variant on the constructor case (as it is now).
650 %************************************************************************
652 %* match on an unmixed block: the real business *
654 %************************************************************************
655 \subsection[matchUnmixedEqns]{@matchUnmixedEqns@: getting down to business}
657 The function @matchUnmixedEqns@ is where the matching stuff sets to
658 work a block of equations, to which the mixture rule has been applied.
659 Its arguments and results are the same as for the ``top-level'' @match@.
662 matchUnmixedEqns :: [Id]
666 matchUnmixedEqns [] _ = panic "matchUnmixedEqns: no names"
668 matchUnmixedEqns all_vars@(var:vars) eqns_info
669 | isWildPat first_pat
670 = ASSERT( all isWildPat column_1_pats ) -- Sanity check
671 -- Real true variables, just like in matchVar, SLPJ p 94
672 -- No binding to do: they'll all be wildcards by now (done in tidy)
673 match vars remaining_eqns_info
676 = ASSERT( patsAreAllCons column_1_pats )
677 matchConFamily all_vars eqns_info
680 = ASSERT( patsAreAllLits column_1_pats )
681 -- see notes in MatchLiteral
682 -- not worried about the same literal more than once in a column
683 -- (ToDo: sort this out later)
684 matchLiterals all_vars eqns_info
687 first_pat = head column_1_pats
688 column_1_pats = [pat | EqnInfo _ _ (pat:_) _ <- eqns_info]
689 remaining_eqns_info = [EqnInfo n ctx pats match_result | EqnInfo n ctx (_:pats) match_result <- eqns_info]
692 %************************************************************************
694 %* matchWrapper: a convenient way to call @match@ *
696 %************************************************************************
697 \subsection[matchWrapper]{@matchWrapper@: a convenient interface to @match@}
699 Calls to @match@ often involve similar (non-trivial) work; that work
700 is collected here, in @matchWrapper@. This function takes as
704 Typchecked @Matches@ (of a function definition, or a case or lambda
705 expression)---the main input;
707 An error message to be inserted into any (runtime) pattern-matching
711 As results, @matchWrapper@ produces:
714 A list of variables (@Locals@) that the caller must ``promise'' to
715 bind to appropriate values; and
717 a @CoreExpr@, the desugared output (main result).
720 The main actions of @matchWrapper@ include:
723 Flatten the @[TypecheckedMatch]@ into a suitable list of
726 Create as many new variables as there are patterns in a pattern-list
727 (in any one of the @EquationInfo@s).
729 Create a suitable ``if it fails'' expression---a call to @error@ using
730 the error-string input; the {\em type} of this fail value can be found
731 by examining one of the RHS expressions in one of the @EquationInfo@s.
733 Call @match@ with all of this information!
737 matchWrapper :: DsMatchKind -- For shadowing warning messages
738 -> [TypecheckedMatch] -- Matches being desugared
739 -> String -- Error message if the match fails
740 -> DsM ([Id], CoreExpr) -- Results
743 There is one small problem with the Lambda Patterns, when somebody
744 writes something similar to:
748 he/she don't want a warning about incomplete patterns, that is done with
749 the flag @opt_WarnSimplePatterns@.
750 This problem also appears in the:
752 \item @do@ patterns, but if the @do@ can fail
753 it creates another equation if the match can fail
754 (see @DsExpr.doDo@ function)
755 \item @let@ patterns, are treated by @matchSimply@
756 List Comprension Patterns, are treated by @matchSimply@ also
759 We can't call @matchSimply@ with Lambda patterns,
760 due to the fact that lambda patterns can have more than
761 one pattern, and match simply only accepts one pattern.
766 matchWrapper kind matches error_string
767 = flattenMatches kind matches `thenDs` \ (result_ty, eqns_info) ->
769 EqnInfo _ _ arg_pats _ : _ = eqns_info
771 mapDs selectMatchVar arg_pats `thenDs` \ new_vars ->
772 match_fun new_vars eqns_info `thenDs` \ match_result ->
774 mkErrorAppDs pAT_ERROR_ID result_ty error_string `thenDs` \ fail_expr ->
775 extractMatchResult match_result fail_expr `thenDs` \ result_expr ->
776 returnDs (new_vars, result_expr)
777 where match_fun = case kind of
778 LambdaMatch | opt_WarnSimplePatterns -> matchExport
783 %************************************************************************
785 \subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern}
787 %************************************************************************
789 @mkSimpleMatch@ is a wrapper for @match@ which deals with the
790 situation where we want to match a single expression against a single
791 pattern. It returns an expression.
794 matchSimply :: CoreExpr -- Scrutinee
795 -> DsMatchKind -- Match kind
796 -> TypecheckedPat -- Pattern it should match
797 -> CoreExpr -- Return this if it matches
798 -> CoreExpr -- Return this if it doesn't
801 matchSimply scrut kind pat result_expr fail_expr
802 = getSrcLocDs `thenDs` \ locn ->
804 ctx = DsMatchContext kind [pat] locn
805 match_result = cantFailMatchResult result_expr
807 matchSinglePat scrut ctx pat match_result `thenDs` \ match_result' ->
808 extractMatchResult match_result' fail_expr
811 matchSinglePat :: CoreExpr -> DsMatchContext -> TypecheckedPat
812 -> MatchResult -> DsM MatchResult
814 matchSinglePat (Var var) ctx pat match_result
815 = match_fn [var] [EqnInfo 1 ctx [pat] match_result]
817 match_fn | opt_WarnSimplePatterns = matchExport
820 matchSinglePat scrut ctx pat match_result
821 = selectMatchVar pat `thenDs` \ var ->
822 matchSinglePat (Var var) ctx pat match_result `thenDs` \ match_result' ->
823 returnDs (adjustMatchResult (bindNonRec var scrut) match_result')
826 %************************************************************************
828 %* flattenMatches : create a list of EquationInfo *
830 %************************************************************************
832 \subsection[flattenMatches]{@flattenMatches@: create @[EquationInfo]@}
834 This is actually local to @matchWrapper@.
839 -> [TypecheckedMatch]
840 -> DsM (Type, [EquationInfo])
842 flattenMatches kind matches
843 = mapAndUnzipDs flatten_match (matches `zip` [1..]) `thenDs` \ (result_tys, eqn_infos) ->
845 result_ty = head result_tys
847 ASSERT( all (== result_ty) result_tys )
848 returnDs (result_ty, eqn_infos)
850 flatten_match (Match _ pats _ grhss, n)
851 = dsGRHSs kind pats grhss `thenDs` \ (ty, match_result) ->
852 getSrcLocDs `thenDs` \ locn ->
853 returnDs (ty, EqnInfo n (DsMatchContext kind pats locn) pats match_result)