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 import DsLoop -- here for paranoia-checking reasons
13 -- and to break dsExpr/dsBinds-ish loop
16 import TcHsSyn ( TypecheckedPat(..), TypecheckedMatch(..),
17 TypecheckedHsBinds(..), TypecheckedHsExpr(..) )
18 import DsHsSyn ( outPatType, collectTypedPatBinders )
22 import DsGRHSs ( dsGRHSs )
24 import MatchCon ( matchConFamily )
25 import MatchLit ( matchLiterals )
27 import CoreUtils ( escErrorMsg, mkErrorApp )
28 import Id ( idType, mkTupleCon, GenId{-instance-} )
29 import PprStyle ( PprStyle(..) )
30 import PprType ( GenTyVar{-instance-}, GenType{-instance-} )
31 import PrelInfo ( nilDataCon, consDataCon, mkTupleTy, mkListTy,
32 charTy, charDataCon, intTy, intDataCon,
33 floatTy, floatDataCon, doubleTy, doubleDataCon,
34 integerTy, intPrimTy, charPrimTy,
35 floatPrimTy, doublePrimTy, stringTy,
36 addrTy, addrPrimTy, addrDataCon,
37 wordTy, wordPrimTy, wordDataCon )
38 import Type ( isPrimType, eqTy )
39 import TyVar ( GenTyVar )
40 import Unique ( Unique )
41 import Util ( panic, pprPanic )
44 The function @match@ is basically the same as in the Wadler chapter,
45 except it is monadised, to carry around the name supply, info about
48 Notes on @match@'s arguments, assuming $m$ equations and $n$ patterns:
51 A list of $n$ variable names, those variables presumably bound to the
52 $n$ expressions being matched against the $n$ patterns. Using the
53 list of $n$ expressions as the first argument showed no benefit and
57 The second argument, a list giving the ``equation info'' for each of
61 the $n$ patterns for that equation, and
63 a list of Core bindings [@(Id, CoreExpr)@ pairs] to be ``stuck on
64 the front'' of the matching code, as in:
70 and finally: (ToDo: fill in)
72 The right way to think about the ``after-match function'' is that it
73 is an embryonic @CoreExpr@ with a ``hole'' at the end for the
74 final ``else expression''.
77 There is a type synonym, @EquationInfo@, defined in module @DsUtils@.
79 An experiment with re-ordering this information about equations (in
80 particular, having the patterns available in column-major order)
84 A default expression---what to evaluate if the overall pattern-match
85 fails. This expression will (almost?) always be
86 a measly expression @Var@, unless we know it will only be used once
87 (as we do in @glue_success_exprs@).
89 Leaving out this third argument to @match@ (and slamming in lots of
90 @Var "fail"@s) is a positively {\em bad} idea, because it makes it
91 impossible to share the default expressions. (Also, it stands no
92 chance of working in our post-upheaval world of @Locals@.)
94 So, the full type signature:
96 match :: [Id] -- Variables rep'ing the exprs we're matching with
97 -> [EquationInfo] -- Info about patterns, etc. (type synonym below)
98 -> [EquationInfo] -- Potentially shadowing equations above this one
99 -> DsM MatchResult -- Desugared result!
102 Note: @match@ is often called via @matchWrapper@ (end of this module),
103 a function that does much of the house-keeping that goes with a call
106 It is also worth mentioning the {\em typical} way a block of equations
107 is desugared with @match@. At each stage, it is the first column of
108 patterns that is examined. The steps carried out are roughly:
111 Tidy the patterns in column~1 with @tidyEqnInfo@ (this may add
112 bindings to the second component of the equation-info):
115 Remove the `as' patterns from column~1.
117 Make all constructor patterns in column~1 into @ConPats@, notably
118 @ListPats@ and @TuplePats@.
120 Handle any irrefutable (or ``twiddle'') @LazyPats@.
123 Now {\em unmix} the equations into {\em blocks} [w/ local function
124 @unmix_eqns@], in which the equations in a block all have variable
125 patterns in column~1, or they all have constructor patterns in ...
126 (see ``the mixture rule'' in SLPJ).
128 Call @matchUnmixedEqns@ on each block of equations; it will do the
129 appropriate thing for each kind of column-1 pattern, usually ending up
130 in a recursive call to @match@.
133 %************************************************************************
135 %* match: empty rule *
137 %************************************************************************
138 \subsection[Match-empty-rule]{The ``empty rule''}
140 We are a little more paranoid about the ``empty rule'' (SLPJ, p.~87)
141 than the Wadler-chapter code for @match@ (p.~93, first @match@ clause).
142 And gluing the ``success expressions'' together isn't quite so pretty.
145 match [] eqns_info shadows
146 = pin_eqns eqns_info `thenDs` \ match_result@(MatchResult _ _ _ cxt) ->
148 -- If at this stage we find that at least one of the shadowing
149 -- equations is guaranteed not to fail, then warn of an overlapping pattern
150 if not (all shadow_can_fail shadows) then
151 dsShadowError cxt `thenDs` \ _ ->
152 returnDs match_result
154 returnDs match_result
157 pin_eqns [EqnInfo [] match_result] = returnDs match_result
158 -- Last eqn... can't have pats ...
160 pin_eqns (EqnInfo [] match_result1 : more_eqns)
161 = pin_eqns more_eqns `thenDs` \ match_result2 ->
162 combineMatchResults match_result1 match_result2
164 pin_eqns other_pat = panic "match: pin_eqns"
166 shadow_can_fail :: EquationInfo -> Bool
168 shadow_can_fail (EqnInfo [] (MatchResult CanFail _ _ _)) = True
169 shadow_can_fail (EqnInfo [] (MatchResult CantFail _ _ _)) = False
170 shadow_can_fail other = panic "match:shadow_can_fail"
173 %************************************************************************
175 %* match: non-empty rule *
177 %************************************************************************
178 \subsection[Match-nonempty]{@match@ when non-empty: unmixing}
180 This (more interesting) clause of @match@ uses @tidy_and_unmix_eqns@
181 (a)~to get `as'- and `twiddle'-patterns out of the way (tidying), and
182 (b)~to do ``the mixture rule'' (SLPJ, p.~88) [which really {\em
183 un}mixes the equations], producing a list of equation-info
184 blocks, each block having as its first column of patterns either all
185 constructors, or all variables (or similar beasts), etc.
187 @match_unmixed_eqn_blks@ simply takes the place of the @foldr@ in the
188 Wadler-chapter @match@ (p.~93, last clause), and @match_unmixed_blk@
189 corresponds roughly to @matchVarCon@.
192 match vars@(v:vs) eqns_info shadows
193 = mapDs (tidyEqnInfo v) eqns_info `thenDs` \ tidy_eqns_info ->
194 mapDs (tidyEqnInfo v) shadows `thenDs` \ tidy_shadows ->
196 tidy_eqns_blks = unmix_eqns tidy_eqns_info
198 match_unmixed_eqn_blks vars tidy_eqns_blks tidy_shadows
201 unmix_eqns [eqn] = [ [eqn] ]
202 unmix_eqns (eq1@(EqnInfo (p1:p1s) _) : eq2@(EqnInfo (p2:p2s) _) : eqs)
203 = if ( (unfailablePat p1 && unfailablePat p2)
204 || (isConPat p1 && isConPat p2)
205 || (isLitPat p1 && isLitPat p2) ) then
206 eq1 `tack_onto` unmixed_rest
208 [ eq1 ] : unmixed_rest
210 unmixed_rest = unmix_eqns (eq2:eqs)
212 x `tack_onto` xss = ( x : head xss) : tail xss
214 -----------------------------------------------------------------------
215 -- loop through the blocks:
216 -- subsequent blocks create a "fail expr" for the first one...
217 match_unmixed_eqn_blks :: [Id]
218 -> [ [EquationInfo] ] -- List of eqn BLOCKS
219 -> [EquationInfo] -- Shadows
222 match_unmixed_eqn_blks vars [] shadows = panic "match_unmixed_eqn_blks"
224 match_unmixed_eqn_blks vars [eqn_blk] shadows = matchUnmixedEqns vars eqn_blk shadows
226 match_unmixed_eqn_blks vars (eqn_blk:eqn_blks) shadows
227 = matchUnmixedEqns vars eqn_blk shadows `thenDs` \ match_result1 -> -- try to match with first blk
228 match_unmixed_eqn_blks vars eqn_blks shadows' `thenDs` \ match_result2 ->
229 combineMatchResults match_result1 match_result2
231 shadows' = eqn_blk ++ shadows
234 Tidy up the leftmost pattern in an @EquationInfo@, given the variable @v@
235 which will be scrutinised. This means:
238 Replace variable patterns @x@ (@x /= v@) with the pattern @_@,
239 together with the binding @x = v@.
241 Replace the `as' pattern @x@@p@ with the pattern p and a binding @x = v@.
243 Removing lazy (irrefutable) patterns (you don't want to know...).
245 Converting explicit tuple- and list-pats into ordinary @ConPats@.
248 The result of this tidying is that the column of patterns will include
252 The @VarPat@ information isn't needed any more after this.
255 @ListPats@, @TuplePats@, etc., are all converted into @ConPats@.
257 \item[@LitPats@ and @NPats@:]
258 @LitPats@/@NPats@ of ``known friendly types'' (Int, Char,
259 Float, Double, at least) are converted to unboxed form; e.g.,
260 \tr{(NPat (HsInt i) _ _)} is converted to:
262 (ConPat I# _ _ [LitPat (HsIntPrim i) _])
267 tidyEqnInfo :: Id -> EquationInfo -> DsM EquationInfo
268 -- DsM'd because of internal call to "match".
269 -- "tidy1" does the interesting stuff, looking at
270 -- one pattern and fiddling the list of bindings.
271 tidyEqnInfo v (EqnInfo (pat : pats) match_result)
272 = tidy1 v pat match_result `thenDs` \ (pat', match_result') ->
273 returnDs (EqnInfo (pat' : pats) match_result')
275 tidy1 :: Id -- The Id being scrutinised
276 -> TypecheckedPat -- The pattern against which it is to be matched
277 -> MatchResult -- Current thing do do after matching
278 -> DsM (TypecheckedPat, -- Equivalent pattern
279 MatchResult) -- Augmented thing to do afterwards
280 -- The augmentation usually takes the form
281 -- of new bindings to be added to the front
283 tidy1 v (VarPat var) match_result
284 = returnDs (WildPat (idType var),
285 mkCoLetsMatchResult extra_binds match_result)
287 extra_binds | v == var = []
288 | otherwise = [NonRec var (Var v)]
290 tidy1 v (AsPat var pat) match_result
291 = tidy1 v pat (mkCoLetsMatchResult extra_binds match_result)
293 extra_binds | v == var = []
294 | otherwise = [NonRec var (Var v)]
296 tidy1 v (WildPat ty) match_result
297 = returnDs (WildPat ty, match_result)
299 {- now, here we handle lazy patterns:
300 tidy1 v ~p bs = (v, v1 = case v of p -> v1 :
301 v2 = case v of p -> v2 : ... : bs )
303 where the v_i's are the binders in the pattern.
305 ToDo: in "v_i = ... -> v_i", are the v_i's really the same thing?
307 The case expr for v_i is just: match [v] [(p, [], \ x -> Var v_i)] any_expr
310 tidy1 v (LazyPat pat) match_result
311 = mkSelectorBinds [] pat l_to_l (Var v) `thenDs` \ sel_binds ->
312 returnDs (WildPat (idType v),
313 mkCoLetsMatchResult [NonRec b rhs | (b,rhs) <- sel_binds] match_result)
315 l_to_l = binders `zip` binders -- Boring
316 binders = collectTypedPatBinders pat
318 -- re-express <con-something> as (ConPat ...) [directly]
320 tidy1 v (ConOpPat pat1 id pat2 ty) match_result
321 = returnDs (ConPat id ty [pat1, pat2], match_result)
323 tidy1 v (ListPat ty pats) match_result
324 = returnDs (list_ConPat, match_result)
326 list_ty = mkListTy ty
328 = foldr (\ x -> \y -> ConPat consDataCon list_ty [x, y])
329 (ConPat nilDataCon list_ty [])
332 tidy1 v (TuplePat pats) match_result
333 = returnDs (tuple_ConPat, match_result)
337 = ConPat (mkTupleCon arity)
338 (mkTupleTy arity (map outPatType pats))
341 tidy1 v (DictPat dicts methods) match_result
342 = case num_of_d_and_ms of
343 0 -> tidy1 v (TuplePat []) match_result
344 1 -> tidy1 v (head dict_and_method_pats) match_result
345 _ -> tidy1 v (TuplePat dict_and_method_pats) match_result
347 num_of_d_and_ms = length dicts + length methods
348 dict_and_method_pats = map VarPat (dicts ++ methods)
351 -- deeply ugly mangling for some (common) NPats/LitPats
353 -- LitPats: the desugarer only sees these at well-known types
355 tidy1 v pat@(LitPat lit lit_ty) match_result
357 = returnDs (pat, match_result)
359 | lit_ty `eqTy` charTy
360 = returnDs (ConPat charDataCon charTy [LitPat (mk_char lit) charPrimTy],
363 | otherwise = pprPanic "tidy1:LitPat:" (ppr PprDebug pat)
365 mk_char (HsChar c) = HsCharPrim c
367 -- NPats: we *might* be able to replace these w/ a simpler form
369 tidy1 v pat@(NPat lit lit_ty _) match_result
370 = returnDs (better_pat, match_result)
373 | lit_ty `eqTy` charTy = ConPat charDataCon lit_ty [LitPat (mk_char lit) charPrimTy]
374 | lit_ty `eqTy` intTy = ConPat intDataCon lit_ty [LitPat (mk_int lit) intPrimTy]
375 | lit_ty `eqTy` wordTy = ConPat wordDataCon lit_ty [LitPat (mk_word lit) wordPrimTy]
376 | lit_ty `eqTy` addrTy = ConPat addrDataCon lit_ty [LitPat (mk_addr lit) addrPrimTy]
377 | lit_ty `eqTy` floatTy = ConPat floatDataCon lit_ty [LitPat (mk_float lit) floatPrimTy]
378 | lit_ty `eqTy` doubleTy = ConPat doubleDataCon lit_ty [LitPat (mk_double lit) doublePrimTy]
381 mk_int (HsInt i) = HsIntPrim i
382 mk_int l@(HsLitLit s) = l
384 mk_char (HsChar c) = HsCharPrim c
385 mk_char l@(HsLitLit s) = l
387 mk_word l@(HsLitLit s) = l
389 mk_addr l@(HsLitLit s) = l
391 mk_float (HsInt i) = HsFloatPrim (fromInteger i)
392 mk_float (HsFrac f) = HsFloatPrim f
393 mk_float l@(HsLitLit s) = l
395 mk_double (HsInt i) = HsDoublePrim (fromInteger i)
396 mk_double (HsFrac f) = HsDoublePrim f
397 mk_double l@(HsLitLit s) = l
399 -- and everything else goes through unchanged...
401 tidy1 v non_interesting_pat match_result
402 = returnDs (non_interesting_pat, match_result)
405 PREVIOUS matchTwiddled STUFF:
407 Now we get to the only interesting part; note: there are choices for
408 translation [from Simon's notes]; translation~1:
415 s = case w of [s,t] -> s
416 t = case w of [s,t] -> t
420 Here \tr{w} is a fresh variable, and the \tr{w}-binding prevents multiple
421 evaluation of \tr{e}. An alternative translation (No.~2):
423 [ w = case e of [s,t] -> (s,t)
424 s = case w of (s,t) -> s
425 t = case w of (s,t) -> t
429 %************************************************************************
431 \subsubsection[improved-unmixing]{UNIMPLEMENTED idea for improved unmixing}
433 %************************************************************************
435 We might be able to optimise unmixing when confronted by
436 only-one-constructor-possible, of which tuples are the most notable
444 This definition would normally be unmixed into four equation blocks,
445 one per equation. But it could be unmixed into just one equation
446 block, because if the one equation matches (on the first column),
447 the others certainly will.
449 You have to be careful, though; the example
457 {\em must} be broken into two blocks at the line shown; otherwise, you
458 are forcing unnecessary evaluation. In any case, the top-left pattern
459 always gives the cue. You could then unmix blocks into groups of...
461 \item[all variables:]
463 \item[constructors or variables (mixed):]
464 Need to make sure the right names get bound for the variable patterns.
465 \item[literals or variables (mixed):]
466 Presumably just a variant on the constructor case (as it is now).
469 %************************************************************************
471 %* match on an unmixed block: the real business *
473 %************************************************************************
474 \subsection[matchUnmixedEqns]{@matchUnmixedEqns@: getting down to business}
476 The function @matchUnmixedEqns@ is where the matching stuff sets to
477 work a block of equations, to which the mixture rule has been applied.
478 Its arguments and results are the same as for the ``top-level'' @match@.
481 matchUnmixedEqns :: [Id]
483 -> [EquationInfo] -- Shadows
486 matchUnmixedEqns [] _ _ = panic "matchUnmixedEqns: no names"
488 matchUnmixedEqns all_vars@(var:vars) eqns_info shadows
489 | unfailablePats column_1_pats -- Could check just one; we know they've been tidied, unmixed;
490 -- this way is (arguably) a sanity-check
491 = -- Real true variables, just like in matchVar, SLPJ p 94
492 match vars remaining_eqns_info remaining_shadows
494 | patsAreAllCons column_1_pats -- ToDo: maybe check just one...
495 = matchConFamily all_vars eqns_info shadows
497 | patsAreAllLits column_1_pats -- ToDo: maybe check just one...
498 = -- see notes in MatchLiteral
499 -- not worried about the same literal more than once in a column
500 -- (ToDo: sort this out later)
501 matchLiterals all_vars eqns_info shadows
504 column_1_pats = [pat | EqnInfo (pat:_) _ <- eqns_info]
505 remaining_eqns_info = [EqnInfo pats match_result | EqnInfo (_:pats) match_result <- eqns_info]
506 remaining_shadows = [EqnInfo pats match_result | EqnInfo (pat:pats) match_result <- shadows,
508 -- Discard shadows which can be refuted, since they don't shadow
512 %************************************************************************
514 %* matchWrapper: a convenient way to call @match@ *
516 %************************************************************************
517 \subsection[matchWrapper]{@matchWrapper@: a convenient interface to @match@}
519 Calls to @match@ often involve similar (non-trivial) work; that work
520 is collected here, in @matchWrapper@. This function takes as
524 Typchecked @Matches@ (of a function definition, or a case or lambda
525 expression)---the main input;
527 An error message to be inserted into any (runtime) pattern-matching
531 As results, @matchWrapper@ produces:
534 A list of variables (@Locals@) that the caller must ``promise'' to
535 bind to appropriate values; and
537 a @CoreExpr@, the desugared output (main result).
540 The main actions of @matchWrapper@ include:
543 Flatten the @[TypecheckedMatch]@ into a suitable list of
546 Create as many new variables as there are patterns in a pattern-list
547 (in any one of the @EquationInfo@s).
549 Create a suitable ``if it fails'' expression---a call to @error@ using
550 the error-string input; the {\em type} of this fail value can be found
551 by examining one of the RHS expressions in one of the @EquationInfo@s.
553 Call @match@ with all of this information!
557 matchWrapper :: DsMatchKind -- For shadowing warning messages
558 -> [TypecheckedMatch] -- Matches being desugared
559 -> String -- Error message if the match fails
560 -> DsM ([Id], CoreExpr) -- Results
562 -- a special case for the common ...:
564 -- lots of (all?) unfailable pats
568 matchWrapper kind [(PatMatch (VarPat var) match)] error_string
569 = matchWrapper kind [match] error_string `thenDs` \ (vars, core_expr) ->
570 returnDs (var:vars, core_expr)
572 matchWrapper kind [(PatMatch (WildPat ty) match)] error_string
573 = newSysLocalDs ty `thenDs` \ var ->
574 matchWrapper kind [match] error_string `thenDs` \ (vars, core_expr) ->
575 returnDs (var:vars, core_expr)
577 matchWrapper kind [(GRHSMatch
578 (GRHSsAndBindsOut [OtherwiseGRHS expr _] binds _))] error_string
579 = dsBinds binds `thenDs` \ core_binds ->
580 dsExpr expr `thenDs` \ core_expr ->
581 returnDs ([], mkCoLetsAny core_binds core_expr)
583 ----------------------------------------------------------------------------
584 -- and all the rest... (general case)
586 matchWrapper kind matches error_string
587 = flattenMatches kind matches `thenDs` \ eqns_info@(EqnInfo arg_pats (MatchResult _ result_ty _ _) : _) ->
589 selectMatchVars arg_pats `thenDs` \ new_vars ->
590 match new_vars eqns_info [] `thenDs` \ match_result ->
592 getSrcLocDs `thenDs` \ (src_file, src_line) ->
593 newSysLocalDs stringTy `thenDs` \ str_var -> -- to hold the String
595 src_loc_str = escErrorMsg ('"' : src_file) ++ "%l" ++ src_line
596 fail_expr = mkErrorApp result_ty str_var (src_loc_str++": "++error_string)
598 extractMatchResult match_result fail_expr `thenDs` \ result_expr ->
599 returnDs (new_vars, result_expr)
602 %************************************************************************
604 \subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern}
606 %************************************************************************
608 @mkSimpleMatch@ is a wrapper for @match@ which deals with the
609 situation where we want to match a single expression against a single
610 pattern. It returns an expression.
613 matchSimply :: CoreExpr -- Scrutinee
614 -> TypecheckedPat -- Pattern it should match
615 -> Type -- Type of result
616 -> CoreExpr -- Return this if it matches
617 -> CoreExpr -- Return this if it does
620 matchSimply (Var var) pat result_ty result_expr fail_expr
621 = match [var] [eqn_info] [] `thenDs` \ match_result ->
622 extractMatchResult match_result fail_expr
624 eqn_info = EqnInfo [pat] initial_match_result
625 initial_match_result = MatchResult CantFail
627 (\ ignore -> result_expr)
630 matchSimply scrut_expr pat result_ty result_expr msg
631 = newSysLocalDs (outPatType pat) `thenDs` \ scrut_var ->
632 matchSimply (Var scrut_var) pat result_ty result_expr msg `thenDs` \ expr ->
633 returnDs (Let (NonRec scrut_var scrut_expr) expr)
636 extractMatchResult (MatchResult CantFail _ match_fn _) fail_expr
637 = returnDs (match_fn (error "It can't fail!"))
639 extractMatchResult (MatchResult CanFail result_ty match_fn _) fail_expr
640 = mkFailurePair result_ty `thenDs` \ (fail_bind_fn, if_it_fails) ->
641 returnDs (Let (fail_bind_fn fail_expr) (match_fn if_it_fails))
644 %************************************************************************
646 %* flattenMatches : create a list of EquationInfo *
648 %************************************************************************
649 \subsection[flattenMatches]{@flattenMatches@: create @[EquationInfo]@}
651 This is actually local to @matchWrapper@.
656 -> [TypecheckedMatch]
657 -> DsM [EquationInfo]
659 flattenMatches kind [] = returnDs []
661 flattenMatches kind (match : matches)
662 = flatten_match [] match `thenDs` \ eqn_info ->
663 flattenMatches kind matches `thenDs` \ eqn_infos ->
664 returnDs (eqn_info : eqn_infos)
666 flatten_match :: [TypecheckedPat] -- Reversed list of patterns encountered so far
670 flatten_match pats_so_far (PatMatch pat match)
671 = flatten_match (pat:pats_so_far) match
673 flatten_match pats_so_far (GRHSMatch (GRHSsAndBindsOut grhss binds ty))
674 = dsBinds binds `thenDs` \ core_binds ->
675 dsGRHSs ty kind pats grhss `thenDs` \ match_result ->
676 returnDs (EqnInfo pats (mkCoLetsMatchResult core_binds match_result))
678 pats = reverse pats_so_far -- They've accumulated in reverse order