2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[Main_match]{The @match@ function}
7 #include "HsVersions.h"
9 module Match ( match, matchWrapper, matchSimply ) where
12 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
13 IMPORT_DELOOPER(DsLoop) -- here for paranoia-checking reasons
14 -- and to break dsExpr/dsBinds-ish loop
16 import {-# SOURCE #-} DsExpr ( dsExpr )
17 import {-# SOURCE #-} DsBinds ( dsBinds )
20 import CmdLineOpts ( opt_WarnIncompletePatterns, opt_WarnOverlappedPatterns )
22 import TcHsSyn ( SYN_IE(TypecheckedPat), SYN_IE(TypecheckedMatch),
23 SYN_IE(TypecheckedHsBinds), SYN_IE(TypecheckedHsExpr) )
24 import DsHsSyn ( outPatType, collectTypedPatBinders )
27 import CoreUtils ( coreExprType )
29 import DsGRHSs ( dsGRHSs )
31 import MatchCon ( matchConFamily )
32 import MatchLit ( matchLiterals )
34 import FieldLabel ( FieldLabel {- Eq instance -} )
35 import Id ( idType, dataConFieldLabels,
36 dataConArgTys, recordSelectorFieldLabel,
37 GenId{-instance-}, SYN_IE(Id)
39 import Name ( Name {--O only-} )
40 import Outputable ( PprStyle(..), Outputable(..) )
41 import PprType ( GenType{-instance-}, GenTyVar{-ditto-} )
43 import PrelVals ( pAT_ERROR_ID )
44 import Type ( isPrimType, eqTy, getAppDataTyConExpandingDicts,
45 instantiateTauTy, SYN_IE(Type)
47 import TyVar ( GenTyVar{-instance Eq-}, SYN_IE(TyVar) )
48 import TysPrim ( intPrimTy, charPrimTy, floatPrimTy, doublePrimTy,
49 addrPrimTy, wordPrimTy
51 import TysWiredIn ( nilDataCon, consDataCon, mkTupleTy, mkListTy,
52 charTy, charDataCon, intTy, intDataCon,
53 floatTy, floatDataCon, doubleTy, tupleCon,
54 doubleDataCon, stringTy, addrTy,
55 addrDataCon, wordTy, wordDataCon
57 import Unique ( Unique{-instance Eq-} )
58 import Util ( panic, pprPanic, assertPanic )
61 The function @match@ is basically the same as in the Wadler chapter,
62 except it is monadised, to carry around the name supply, info about
65 Notes on @match@'s arguments, assuming $m$ equations and $n$ patterns:
68 A list of $n$ variable names, those variables presumably bound to the
69 $n$ expressions being matched against the $n$ patterns. Using the
70 list of $n$ expressions as the first argument showed no benefit and
74 The second argument, a list giving the ``equation info'' for each of
78 the $n$ patterns for that equation, and
80 a list of Core bindings [@(Id, CoreExpr)@ pairs] to be ``stuck on
81 the front'' of the matching code, as in:
87 and finally: (ToDo: fill in)
89 The right way to think about the ``after-match function'' is that it
90 is an embryonic @CoreExpr@ with a ``hole'' at the end for the
91 final ``else expression''.
94 There is a type synonym, @EquationInfo@, defined in module @DsUtils@.
96 An experiment with re-ordering this information about equations (in
97 particular, having the patterns available in column-major order)
101 A default expression---what to evaluate if the overall pattern-match
102 fails. This expression will (almost?) always be
103 a measly expression @Var@, unless we know it will only be used once
104 (as we do in @glue_success_exprs@).
106 Leaving out this third argument to @match@ (and slamming in lots of
107 @Var "fail"@s) is a positively {\em bad} idea, because it makes it
108 impossible to share the default expressions. (Also, it stands no
109 chance of working in our post-upheaval world of @Locals@.)
111 So, the full type signature:
113 match :: [Id] -- Variables rep'ing the exprs we're matching with
114 -> [EquationInfo] -- Info about patterns, etc. (type synonym below)
115 -> [EquationInfo] -- Potentially shadowing equations above this one
116 -> DsM MatchResult -- Desugared result!
119 Note: @match@ is often called via @matchWrapper@ (end of this module),
120 a function that does much of the house-keeping that goes with a call
123 It is also worth mentioning the {\em typical} way a block of equations
124 is desugared with @match@. At each stage, it is the first column of
125 patterns that is examined. The steps carried out are roughly:
128 Tidy the patterns in column~1 with @tidyEqnInfo@ (this may add
129 bindings to the second component of the equation-info):
132 Remove the `as' patterns from column~1.
134 Make all constructor patterns in column~1 into @ConPats@, notably
135 @ListPats@ and @TuplePats@.
137 Handle any irrefutable (or ``twiddle'') @LazyPats@.
140 Now {\em unmix} the equations into {\em blocks} [w/ local function
141 @unmix_eqns@], in which the equations in a block all have variable
142 patterns in column~1, or they all have constructor patterns in ...
143 (see ``the mixture rule'' in SLPJ).
145 Call @matchUnmixedEqns@ on each block of equations; it will do the
146 appropriate thing for each kind of column-1 pattern, usually ending up
147 in a recursive call to @match@.
150 %************************************************************************
152 %* match: empty rule *
154 %************************************************************************
155 \subsection[Match-empty-rule]{The ``empty rule''}
157 We are a little more paranoid about the ``empty rule'' (SLPJ, p.~87)
158 than the Wadler-chapter code for @match@ (p.~93, first @match@ clause).
159 And gluing the ``success expressions'' together isn't quite so pretty.
162 match [] eqns_info shadows
163 = complete_matches eqns_info (any eqn_cant_fail shadows)
165 complete_matches [eqn] is_shadowed
166 = complete_match eqn is_shadowed
168 complete_matches (eqn:eqns) is_shadowed
169 = complete_match eqn is_shadowed `thenDs` \ match_result1 ->
170 complete_matches eqns (is_shadowed || eqn_cant_fail eqn) `thenDs` \ match_result2 ->
171 combineMatchResults match_result1 match_result2
173 -- If at this stage we find that at least one of the shadowing
174 -- equations is guaranteed not to fail, then warn of an overlapping pattern
175 complete_match (EqnInfo [] match_result@(MatchResult _ _ _ cxt)) is_shadowed
176 | opt_WarnOverlappedPatterns && is_shadowed =
177 dsShadowWarn cxt `thenDs` \ _ ->
178 returnDs match_result
180 | otherwise = returnDs match_result
182 eqn_cant_fail :: EquationInfo -> Bool
183 eqn_cant_fail (EqnInfo [] (MatchResult CanFail _ _ _)) = False
184 eqn_cant_fail (EqnInfo [] (MatchResult CantFail _ _ _)) = True
187 %************************************************************************
189 %* match: non-empty rule *
191 %************************************************************************
192 \subsection[Match-nonempty]{@match@ when non-empty: unmixing}
194 This (more interesting) clause of @match@ uses @tidy_and_unmix_eqns@
195 (a)~to get `as'- and `twiddle'-patterns out of the way (tidying), and
196 (b)~to do ``the mixture rule'' (SLPJ, p.~88) [which really {\em
197 un}mixes the equations], producing a list of equation-info
198 blocks, each block having as its first column of patterns either all
199 constructors, or all variables (or similar beasts), etc.
201 @match_unmixed_eqn_blks@ simply takes the place of the @foldr@ in the
202 Wadler-chapter @match@ (p.~93, last clause), and @match_unmixed_blk@
203 corresponds roughly to @matchVarCon@.
206 match vars@(v:vs) eqns_info shadows
207 = mapDs (tidyEqnInfo v) eqns_info `thenDs` \ tidy_eqns_info ->
208 mapDs (tidyEqnInfo v) shadows `thenDs` \ tidy_shadows ->
210 tidy_eqns_blks = unmix_eqns tidy_eqns_info
212 match_unmixed_eqn_blks vars tidy_eqns_blks tidy_shadows
215 unmix_eqns [eqn] = [ [eqn] ]
216 unmix_eqns (eq1@(EqnInfo (p1:p1s) _) : eq2@(EqnInfo (p2:p2s) _) : eqs)
217 = if ( (irrefutablePat p1 && irrefutablePat p2)
218 || (isConPat p1 && isConPat p2)
219 || (isLitPat p1 && isLitPat p2) ) then
220 eq1 `tack_onto` unmixed_rest
222 [ eq1 ] : unmixed_rest
224 unmixed_rest = unmix_eqns (eq2:eqs)
226 x `tack_onto` xss = ( x : head xss) : tail xss
228 -----------------------------------------------------------------------
229 -- loop through the blocks:
230 -- subsequent blocks create a "fail expr" for the first one...
231 match_unmixed_eqn_blks :: [Id]
232 -> [ [EquationInfo] ] -- List of eqn BLOCKS
233 -> [EquationInfo] -- Shadows
236 match_unmixed_eqn_blks vars [] shadows = panic "match_unmixed_eqn_blks"
238 match_unmixed_eqn_blks vars [eqn_blk] shadows = matchUnmixedEqns vars eqn_blk shadows
240 match_unmixed_eqn_blks vars (eqn_blk:eqn_blks) shadows
241 = matchUnmixedEqns vars eqn_blk shadows `thenDs` \ match_result1 -> -- try to match with first blk
242 match_unmixed_eqn_blks vars eqn_blks shadows' `thenDs` \ match_result2 ->
243 combineMatchResults match_result1 match_result2
245 shadows' = eqn_blk ++ shadows
248 Tidy up the leftmost pattern in an @EquationInfo@, given the variable @v@
249 which will be scrutinised. This means:
252 Replace variable patterns @x@ (@x /= v@) with the pattern @_@,
253 together with the binding @x = v@.
255 Replace the `as' pattern @x@@p@ with the pattern p and a binding @x = v@.
257 Removing lazy (irrefutable) patterns (you don't want to know...).
259 Converting explicit tuple- and list-pats into ordinary @ConPats@.
261 Convert the literal pat "" to [].
264 The result of this tidying is that the column of patterns will include
268 The @VarPat@ information isn't needed any more after this.
271 @ListPats@, @TuplePats@, etc., are all converted into @ConPats@.
273 \item[@LitPats@ and @NPats@:]
274 @LitPats@/@NPats@ of ``known friendly types'' (Int, Char,
275 Float, Double, at least) are converted to unboxed form; e.g.,
276 \tr{(NPat (HsInt i) _ _)} is converted to:
278 (ConPat I# _ _ [LitPat (HsIntPrim i) _])
283 tidyEqnInfo :: Id -> EquationInfo -> DsM EquationInfo
284 -- DsM'd because of internal call to "match".
285 -- "tidy1" does the interesting stuff, looking at
286 -- one pattern and fiddling the list of bindings.
287 tidyEqnInfo v (EqnInfo (pat : pats) match_result)
288 = tidy1 v pat match_result `thenDs` \ (pat', match_result') ->
289 returnDs (EqnInfo (pat' : pats) match_result')
291 tidy1 :: Id -- The Id being scrutinised
292 -> TypecheckedPat -- The pattern against which it is to be matched
293 -> MatchResult -- Current thing do do after matching
294 -> DsM (TypecheckedPat, -- Equivalent pattern
295 MatchResult) -- Augmented thing to do afterwards
296 -- The augmentation usually takes the form
297 -- of new bindings to be added to the front
299 tidy1 v (VarPat var) match_result
300 = returnDs (WildPat (idType var),
301 mkCoLetsMatchResult extra_binds match_result)
303 extra_binds | v == var = []
304 | otherwise = [NonRec var (Var v)]
306 tidy1 v (AsPat var pat) match_result
307 = tidy1 v pat (mkCoLetsMatchResult extra_binds match_result)
309 extra_binds | v == var = []
310 | otherwise = [NonRec var (Var v)]
312 tidy1 v (WildPat ty) match_result
313 = returnDs (WildPat ty, match_result)
315 {- now, here we handle lazy patterns:
316 tidy1 v ~p bs = (v, v1 = case v of p -> v1 :
317 v2 = case v of p -> v2 : ... : bs )
319 where the v_i's are the binders in the pattern.
321 ToDo: in "v_i = ... -> v_i", are the v_i's really the same thing?
323 The case expr for v_i is just: match [v] [(p, [], \ x -> Var v_i)] any_expr
326 tidy1 v (LazyPat pat) match_result
327 = mkSelectorBinds pat (Var v) `thenDs` \ sel_binds ->
328 returnDs (WildPat (idType v),
329 mkCoLetsMatchResult [NonRec b rhs | (b,rhs) <- sel_binds] match_result)
331 -- re-express <con-something> as (ConPat ...) [directly]
333 tidy1 v (ConOpPat pat1 id pat2 ty) match_result
334 = returnDs (ConPat id ty [pat1, pat2], match_result)
336 tidy1 v (RecPat con_id pat_ty rpats) match_result
337 = returnDs (ConPat con_id pat_ty pats, match_result)
339 pats = map mk_pat tagged_arg_tys
341 -- Boring stuff to find the arg-tys of the constructor
342 (_, inst_tys, _) = getAppDataTyConExpandingDicts pat_ty
343 con_arg_tys' = dataConArgTys con_id inst_tys
344 tagged_arg_tys = con_arg_tys' `zip` (dataConFieldLabels con_id)
346 -- mk_pat picks a WildPat of the appropriate type for absent fields,
347 -- and the specified pattern for present fields
348 mk_pat (arg_ty, lbl) = case [pat | (sel_id,pat,_) <- rpats,
349 recordSelectorFieldLabel sel_id == lbl
351 (pat:pats) -> ASSERT( null pats )
355 tidy1 v (ListPat ty pats) match_result
356 = returnDs (list_ConPat, match_result)
358 list_ty = mkListTy ty
360 = foldr (\ x -> \y -> ConPat consDataCon list_ty [x, y])
361 (ConPat nilDataCon list_ty [])
364 tidy1 v (TuplePat pats) match_result
365 = returnDs (tuple_ConPat, match_result)
369 = ConPat (tupleCon arity)
370 (mkTupleTy arity (map outPatType pats))
373 tidy1 v (DictPat dicts methods) match_result
374 = case num_of_d_and_ms of
375 0 -> tidy1 v (TuplePat []) match_result
376 1 -> tidy1 v (head dict_and_method_pats) match_result
377 _ -> tidy1 v (TuplePat dict_and_method_pats) match_result
379 num_of_d_and_ms = length dicts + length methods
380 dict_and_method_pats = map VarPat (dicts ++ methods)
383 -- deeply ugly mangling for some (common) NPats/LitPats
385 -- LitPats: the desugarer only sees these at well-known types
387 tidy1 v pat@(LitPat lit lit_ty) match_result
389 = returnDs (pat, match_result)
391 | lit_ty `eqTy` charTy
392 = returnDs (ConPat charDataCon charTy [LitPat (mk_char lit) charPrimTy],
395 | otherwise = pprPanic "tidy1:LitPat:" (ppr PprDebug pat)
397 mk_char (HsChar c) = HsCharPrim c
399 -- NPats: we *might* be able to replace these w/ a simpler form
402 tidy1 v pat@(NPat lit lit_ty _) match_result
403 = returnDs (better_pat, match_result)
406 | lit_ty `eqTy` charTy = ConPat charDataCon lit_ty [LitPat (mk_char lit) charPrimTy]
407 | lit_ty `eqTy` intTy = ConPat intDataCon lit_ty [LitPat (mk_int lit) intPrimTy]
408 | lit_ty `eqTy` wordTy = ConPat wordDataCon lit_ty [LitPat (mk_word lit) wordPrimTy]
409 | lit_ty `eqTy` addrTy = ConPat addrDataCon lit_ty [LitPat (mk_addr lit) addrPrimTy]
410 | lit_ty `eqTy` floatTy = ConPat floatDataCon lit_ty [LitPat (mk_float lit) floatPrimTy]
411 | lit_ty `eqTy` doubleTy = ConPat doubleDataCon lit_ty [LitPat (mk_double lit) doublePrimTy]
413 -- Convert the literal pattern "" to the constructor pattern [].
414 | null_str_lit lit = ConPat nilDataCon lit_ty []
418 mk_int (HsInt i) = HsIntPrim i
419 mk_int l@(HsLitLit s) = l
421 mk_char (HsChar c) = HsCharPrim c
422 mk_char l@(HsLitLit s) = l
424 mk_word l@(HsLitLit s) = l
426 mk_addr l@(HsLitLit s) = l
428 mk_float (HsInt i) = HsFloatPrim (fromInteger i)
429 mk_float (HsFrac f) = HsFloatPrim f
430 mk_float l@(HsLitLit s) = l
432 mk_double (HsInt i) = HsDoublePrim (fromInteger i)
433 mk_double (HsFrac f) = HsDoublePrim f
434 mk_double l@(HsLitLit s) = l
436 null_str_lit (HsString s) = _NULL_ s
437 null_str_lit other_lit = False
439 -- and everything else goes through unchanged...
441 tidy1 v non_interesting_pat match_result
442 = returnDs (non_interesting_pat, match_result)
445 PREVIOUS matchTwiddled STUFF:
447 Now we get to the only interesting part; note: there are choices for
448 translation [from Simon's notes]; translation~1:
455 s = case w of [s,t] -> s
456 t = case w of [s,t] -> t
460 Here \tr{w} is a fresh variable, and the \tr{w}-binding prevents multiple
461 evaluation of \tr{e}. An alternative translation (No.~2):
463 [ w = case e of [s,t] -> (s,t)
464 s = case w of (s,t) -> s
465 t = case w of (s,t) -> t
469 %************************************************************************
471 \subsubsection[improved-unmixing]{UNIMPLEMENTED idea for improved unmixing}
473 %************************************************************************
475 We might be able to optimise unmixing when confronted by
476 only-one-constructor-possible, of which tuples are the most notable
484 This definition would normally be unmixed into four equation blocks,
485 one per equation. But it could be unmixed into just one equation
486 block, because if the one equation matches (on the first column),
487 the others certainly will.
489 You have to be careful, though; the example
497 {\em must} be broken into two blocks at the line shown; otherwise, you
498 are forcing unnecessary evaluation. In any case, the top-left pattern
499 always gives the cue. You could then unmix blocks into groups of...
501 \item[all variables:]
503 \item[constructors or variables (mixed):]
504 Need to make sure the right names get bound for the variable patterns.
505 \item[literals or variables (mixed):]
506 Presumably just a variant on the constructor case (as it is now).
509 %************************************************************************
511 %* match on an unmixed block: the real business *
513 %************************************************************************
514 \subsection[matchUnmixedEqns]{@matchUnmixedEqns@: getting down to business}
516 The function @matchUnmixedEqns@ is where the matching stuff sets to
517 work a block of equations, to which the mixture rule has been applied.
518 Its arguments and results are the same as for the ``top-level'' @match@.
521 matchUnmixedEqns :: [Id]
523 -> [EquationInfo] -- Shadows
526 matchUnmixedEqns [] _ _ = panic "matchUnmixedEqns: no names"
528 matchUnmixedEqns all_vars@(var:vars) eqns_info shadows
529 | irrefutablePat first_pat
530 = ASSERT( irrefutablePats column_1_pats ) -- Sanity check
531 -- Real true variables, just like in matchVar, SLPJ p 94
532 match vars remaining_eqns_info remaining_shadows
535 = ASSERT( patsAreAllCons column_1_pats )
536 matchConFamily all_vars eqns_info shadows
539 = ASSERT( patsAreAllLits column_1_pats )
540 -- see notes in MatchLiteral
541 -- not worried about the same literal more than once in a column
542 -- (ToDo: sort this out later)
543 matchLiterals all_vars eqns_info shadows
546 first_pat = head column_1_pats
547 column_1_pats = [pat | EqnInfo (pat:_) _ <- eqns_info]
548 remaining_eqns_info = [EqnInfo pats match_result | EqnInfo (_:pats) match_result <- eqns_info]
549 remaining_shadows = [EqnInfo pats match_result | EqnInfo (pat:pats) match_result <- shadows,
551 -- Discard shadows which can be refuted, since they don't shadow
555 %************************************************************************
557 %* matchWrapper: a convenient way to call @match@ *
559 %************************************************************************
560 \subsection[matchWrapper]{@matchWrapper@: a convenient interface to @match@}
562 Calls to @match@ often involve similar (non-trivial) work; that work
563 is collected here, in @matchWrapper@. This function takes as
567 Typchecked @Matches@ (of a function definition, or a case or lambda
568 expression)---the main input;
570 An error message to be inserted into any (runtime) pattern-matching
574 As results, @matchWrapper@ produces:
577 A list of variables (@Locals@) that the caller must ``promise'' to
578 bind to appropriate values; and
580 a @CoreExpr@, the desugared output (main result).
583 The main actions of @matchWrapper@ include:
586 Flatten the @[TypecheckedMatch]@ into a suitable list of
589 Create as many new variables as there are patterns in a pattern-list
590 (in any one of the @EquationInfo@s).
592 Create a suitable ``if it fails'' expression---a call to @error@ using
593 the error-string input; the {\em type} of this fail value can be found
594 by examining one of the RHS expressions in one of the @EquationInfo@s.
596 Call @match@ with all of this information!
600 matchWrapper :: DsMatchKind -- For shadowing warning messages
601 -> [TypecheckedMatch] -- Matches being desugared
602 -> String -- Error message if the match fails
603 -> DsM ([Id], CoreExpr) -- Results
605 -- a special case for the common ...:
607 -- lots of (all?) unfailable pats
611 matchWrapper kind [(PatMatch (VarPat var) match)] error_string
612 = matchWrapper kind [match] error_string `thenDs` \ (vars, core_expr) ->
613 returnDs (var:vars, core_expr)
615 matchWrapper kind [(PatMatch (WildPat ty) match)] error_string
616 = newSysLocalDs ty `thenDs` \ var ->
617 matchWrapper kind [match] error_string `thenDs` \ (vars, core_expr) ->
618 returnDs (var:vars, core_expr)
620 matchWrapper kind [(GRHSMatch
621 (GRHSsAndBindsOut [OtherwiseGRHS expr _] binds _))] error_string
622 = dsBinds False{-don't auto-scc-} binds `thenDs` \ core_binds ->
623 dsExpr expr `thenDs` \ core_expr ->
624 returnDs ([], mkCoLetsAny core_binds core_expr)
626 ----------------------------------------------------------------------------
627 -- and all the rest... (general case)
629 matchWrapper kind matches error_string
630 = flattenMatches kind matches `thenDs` \ eqns_info@(EqnInfo arg_pats (MatchResult _ result_ty _ _) : _) ->
632 selectMatchVars arg_pats `thenDs` \ new_vars ->
633 match new_vars eqns_info [] `thenDs` \ match_result ->
635 mkErrorAppDs pAT_ERROR_ID result_ty error_string `thenDs` \ fail_expr ->
637 -- Check for incomplete pattern match
638 (case match_result of
639 MatchResult CanFail result_ty match_fn cxt
640 | opt_WarnIncompletePatterns
641 -> dsIncompleteWarn cxt
645 extractMatchResult match_result fail_expr `thenDs` \ result_expr ->
646 returnDs (new_vars, result_expr)
649 %************************************************************************
651 \subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern}
653 %************************************************************************
655 @mkSimpleMatch@ is a wrapper for @match@ which deals with the
656 situation where we want to match a single expression against a single
657 pattern. It returns an expression.
660 matchSimply :: CoreExpr -- Scrutinee
661 -> TypecheckedPat -- Pattern it should match
662 -> Type -- Type of result
663 -> CoreExpr -- Return this if it matches
664 -> CoreExpr -- Return this if it does
667 matchSimply (Var var) pat result_ty result_expr fail_expr
668 = match [var] [eqn_info] [] `thenDs` \ match_result ->
669 extractMatchResult match_result fail_expr
671 eqn_info = EqnInfo [pat] initial_match_result
672 initial_match_result = MatchResult CantFail
674 (\ ignore -> result_expr)
677 matchSimply scrut_expr pat result_ty result_expr msg
678 = newSysLocalDs (outPatType pat) `thenDs` \ scrut_var ->
679 matchSimply (Var scrut_var) pat result_ty result_expr msg `thenDs` \ expr ->
680 returnDs (Let (NonRec scrut_var scrut_expr) expr)
683 extractMatchResult (MatchResult CantFail _ match_fn _) fail_expr
684 = returnDs (match_fn (error "It can't fail!"))
686 extractMatchResult (MatchResult CanFail result_ty match_fn cxt) fail_expr
687 = mkFailurePair result_ty `thenDs` \ (fail_bind_fn, if_it_fails) ->
688 returnDs (Let (fail_bind_fn fail_expr) (match_fn if_it_fails))
691 %************************************************************************
693 %* flattenMatches : create a list of EquationInfo *
695 %************************************************************************
696 \subsection[flattenMatches]{@flattenMatches@: create @[EquationInfo]@}
698 This is actually local to @matchWrapper@.
703 -> [TypecheckedMatch]
704 -> DsM [EquationInfo]
706 flattenMatches kind [] = returnDs []
708 flattenMatches kind (match : matches)
709 = flatten_match [] match `thenDs` \ eqn_info ->
710 flattenMatches kind matches `thenDs` \ eqn_infos ->
711 returnDs (eqn_info : eqn_infos)
713 flatten_match :: [TypecheckedPat] -- Reversed list of patterns encountered so far
717 flatten_match pats_so_far (PatMatch pat match)
718 = flatten_match (pat:pats_so_far) match
720 flatten_match pats_so_far (GRHSMatch (GRHSsAndBindsOut grhss binds ty))
721 = dsBinds False{-don't auto-scc-} binds `thenDs` \ core_binds ->
722 dsGRHSs ty kind pats grhss `thenDs` \ match_result ->
723 returnDs (EqnInfo pats (mkCoLetsMatchResult core_binds match_result))
725 pats = reverse pats_so_far -- They've accumulated in reverse order
727 flatten_match pats_so_far (SimpleMatch expr)
728 = dsExpr expr `thenDs` \ core_expr ->
729 getSrcLocDs `thenDs` \ locn ->
730 returnDs (EqnInfo pats
731 (MatchResult CantFail (coreExprType core_expr)
732 (\ ignore -> core_expr)
733 (DsMatchContext kind pats locn)))
735 -- the matching can't fail, so we won't generate an error message.
737 pats = reverse pats_so_far -- They've accumulated in reverse order