ghc/compiler/deSugar/Match.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[Main_match]{The @match@ function}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module Match ( match, matchWrapper, matchSimply ) where
  10
  11 import Ubiq
  12 import DsLoop           -- here for paranoia-checking reasons
  13                         -- and to break dsExpr/dsBinds-ish loop
  14
  15 import HsSyn
  16 import TcHsSyn          ( TypecheckedPat(..), TypecheckedMatch(..),
  17                           TypecheckedHsBinds(..), TypecheckedHsExpr(..) )
  18 import DsHsSyn          ( outPatType, collectTypedPatBinders )
  19 import CoreSyn
  20
  21 import DsMonad
  22 import DsGRHSs          ( dsGRHSs )
  23 import DsUtils
  24 import MatchCon         ( matchConFamily )
  25 import MatchLit         ( matchLiterals )
  26
  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 )
  42 \end{code}
  43
  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
  46 annotations, etc.
  47
  48 Notes on @match@'s arguments, assuming $m$ equations and $n$ patterns:
  49 \begin{enumerate}
  50 \item
  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
  54 some inelegance.
  55
  56 \item
  57 The second argument, a list giving the ``equation info'' for each of
  58 the $m$ equations:
  59 \begin{itemize}
  60 \item
  61 the $n$ patterns for that equation, and
  62 \item
  63 a list of Core bindings [@(Id, CoreExpr)@ pairs] to be ``stuck on
  64 the front'' of the matching code, as in:
  65 \begin{verbatim}
  66 let <binds>
  67 in  <matching-code>
  68 \end{verbatim}
  69 \item
  70 and finally: (ToDo: fill in)
  71
  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''.
  75 \end{itemize}
  76
  77 There is a type synonym, @EquationInfo@, defined in module @DsUtils@.
  78
  79 An experiment with re-ordering this information about equations (in
  80 particular, having the patterns available in column-major order)
  81 showed no benefit.
  82
  83 \item
  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@).
  88
  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@.)
  93 \end{enumerate}
  94 So, the full type signature:
  95 \begin{code}
  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!
 100 \end{code}
 101
 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
 104 to @match@.
 105
 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:
 109 \begin{enumerate}
 110 \item
 111 Tidy the patterns in column~1 with @tidyEqnInfo@ (this may add
 112 bindings to the second component of the equation-info):
 113 \begin{itemize}
 114 \item
 115 Remove the `as' patterns from column~1.
 116 \item
 117 Make all constructor patterns in column~1 into @ConPats@, notably
 118 @ListPats@ and @TuplePats@.
 119 \item
 120 Handle any irrefutable (or ``twiddle'') @LazyPats@.
 121 \end{itemize}
 122 \item
 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).
 127 \item
 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@.
 131 \end{enumerate}
 132
 133 %************************************************************************
 134 %*                                                                      *
 135 %*  match: empty rule                                                   *
 136 %*                                                                      *
 137 %************************************************************************
 138 \subsection[Match-empty-rule]{The ``empty rule''}
 139
 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.
 143
 144 \begin{code}
 145 match [] eqns_info shadows
 146   = pin_eqns eqns_info          `thenDs` \ match_result@(MatchResult _ _ _ cxt) ->
 147
 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
 153     else
 154         returnDs match_result
 155
 156   where
 157     pin_eqns [EqnInfo [] match_result] = returnDs match_result
 158       -- Last eqn... can't have pats ...
 159
 160     pin_eqns (EqnInfo [] match_result1 : more_eqns)
 161       = pin_eqns more_eqns                      `thenDs` \ match_result2 ->
 162         combineMatchResults match_result1 match_result2
 163
 164     pin_eqns other_pat = panic "match: pin_eqns"
 165
 166     shadow_can_fail :: EquationInfo -> Bool
 167
 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"
 171 \end{code}
 172
 173 %************************************************************************
 174 %*                                                                      *
 175 %*  match: non-empty rule                                               *
 176 %*                                                                      *
 177 %************************************************************************
 178 \subsection[Match-nonempty]{@match@ when non-empty: unmixing}
 179
 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.
 186
 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@.
 190
 191 \begin{code}
 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 ->
 195     let
 196         tidy_eqns_blks = unmix_eqns tidy_eqns_info
 197     in
 198     match_unmixed_eqn_blks vars tidy_eqns_blks tidy_shadows
 199   where
 200     unmix_eqns []    = []
 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
 207         else
 208             [ eq1 ] : unmixed_rest
 209       where
 210         unmixed_rest = unmix_eqns (eq2:eqs)
 211
 212         x `tack_onto` xss   = ( x : head xss) : tail xss
 213
 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
 220                            -> DsM MatchResult
 221
 222     match_unmixed_eqn_blks vars [] shadows = panic "match_unmixed_eqn_blks"
 223
 224     match_unmixed_eqn_blks vars [eqn_blk] shadows = matchUnmixedEqns vars eqn_blk shadows
 225
 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
 230       where
 231         shadows' = eqn_blk ++ shadows
 232 \end{code}
 233
 234 Tidy up the leftmost pattern in an @EquationInfo@, given the variable @v@
 235 which will be scrutinised.  This means:
 236 \begin{itemize}
 237 \item
 238 Replace variable patterns @x@ (@x /= v@) with the pattern @_@,
 239 together with the binding @x = v@.
 240 \item
 241 Replace the `as' pattern @x@@p@ with the pattern p and a binding @x = v@.
 242 \item
 243 Removing lazy (irrefutable) patterns (you don't want to know...).
 244 \item
 245 Converting explicit tuple- and list-pats into ordinary @ConPats@.
 246 \end{itemize}
 247
 248 The result of this tidying is that the column of patterns will include
 249 {\em only}:
 250 \begin{description}
 251 \item[@WildPats@:]
 252 The @VarPat@ information isn't needed any more after this.
 253
 254 \item[@ConPats@:]
 255 @ListPats@, @TuplePats@, etc., are all converted into @ConPats@.
 256
 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:
 261 \begin{verbatim}
 262 (ConPat I# _ _ [LitPat (HsIntPrim i) _])
 263 \end{verbatim}
 264 \end{description}
 265
 266 \begin{code}
 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')
 274
 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
 282
 283 tidy1 v (VarPat var) match_result
 284   = returnDs (WildPat (idType var),
 285               mkCoLetsMatchResult extra_binds match_result)
 286   where
 287     extra_binds | v == var  = []
 288                 | otherwise = [NonRec var (Var v)]
 289
 290 tidy1 v (AsPat var pat) match_result
 291   = tidy1 v pat (mkCoLetsMatchResult extra_binds match_result)
 292   where
 293     extra_binds | v == var  = []
 294                 | otherwise = [NonRec var (Var v)]
 295
 296 tidy1 v (WildPat ty) match_result
 297   = returnDs (WildPat ty, match_result)
 298
 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 )
 302
 303     where the v_i's are the binders in the pattern.
 304
 305     ToDo: in "v_i = ... -> v_i", are the v_i's really the same thing?
 306
 307     The case expr for v_i is just: match [v] [(p, [], \ x -> Var v_i)] any_expr
 308 -}
 309
 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)
 314   where
 315     l_to_l = binders `zip` binders      -- Boring
 316     binders = collectTypedPatBinders pat
 317
 318 -- re-express <con-something> as (ConPat ...) [directly]
 319
 320 tidy1 v (ConOpPat pat1 id pat2 ty) match_result
 321   = returnDs (ConPat id ty [pat1, pat2], match_result)
 322
 323 tidy1 v (ListPat ty pats) match_result
 324   = returnDs (list_ConPat, match_result)
 325   where
 326     list_ty = mkListTy ty
 327     list_ConPat
 328       = foldr (\ x -> \y -> ConPat consDataCon list_ty [x, y])
 329               (ConPat nilDataCon  list_ty [])
 330               pats
 331
 332 tidy1 v (TuplePat pats) match_result
 333   = returnDs (tuple_ConPat, match_result)
 334   where
 335     arity = length pats
 336     tuple_ConPat
 337       = ConPat (mkTupleCon arity)
 338                (mkTupleTy arity (map outPatType pats))
 339                pats
 340
 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
 346   where
 347     num_of_d_and_ms      = length dicts + length methods
 348     dict_and_method_pats = map VarPat (dicts ++ methods)
 349
 350
 351 -- deeply ugly mangling for some (common) NPats/LitPats
 352
 353 -- LitPats: the desugarer only sees these at well-known types
 354
 355 tidy1 v pat@(LitPat lit lit_ty) match_result
 356   | isPrimType lit_ty
 357   = returnDs (pat, match_result)
 358
 359   | lit_ty `eqTy` charTy
 360   = returnDs (ConPat charDataCon charTy [LitPat (mk_char lit) charPrimTy],
 361               match_result)
 362
 363   | otherwise = pprPanic "tidy1:LitPat:" (ppr PprDebug pat)
 364   where
 365     mk_char (HsChar c)    = HsCharPrim c
 366
 367 -- NPats: we *might* be able to replace these w/ a simpler form
 368
 369 tidy1 v pat@(NPat lit lit_ty _) match_result
 370   = returnDs (better_pat, match_result)
 371   where
 372     better_pat
 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]
 379       | otherwise          = pat
 380
 381     mk_int    (HsInt i)      = HsIntPrim i
 382     mk_int    l@(HsLitLit s) = l
 383
 384     mk_char   (HsChar c)     = HsCharPrim c
 385     mk_char   l@(HsLitLit s) = l
 386
 387     mk_word   l@(HsLitLit s) = l
 388
 389     mk_addr   l@(HsLitLit s) = l
 390
 391     mk_float  (HsInt i)      = HsFloatPrim (fromInteger i)
 392     mk_float  (HsFrac f)     = HsFloatPrim f
 393     mk_float  l@(HsLitLit s) = l
 394
 395     mk_double (HsInt i)      = HsDoublePrim (fromInteger i)
 396     mk_double (HsFrac f)     = HsDoublePrim f
 397     mk_double l@(HsLitLit s) = l
 398
 399 -- and everything else goes through unchanged...
 400
 401 tidy1 v non_interesting_pat match_result
 402   = returnDs (non_interesting_pat, match_result)
 403 \end{code}
 404
 405 PREVIOUS matchTwiddled STUFF:
 406
 407 Now we get to the only interesting part; note: there are choices for
 408 translation [from Simon's notes]; translation~1:
 409 \begin{verbatim}
 410 deTwiddle [s,t] e
 411 \end{verbatim}
 412 returns
 413 \begin{verbatim}
 414 [ w = e,
 415   s = case w of [s,t] -> s
 416   t = case w of [s,t] -> t
 417 ]
 418 \end{verbatim}
 419
 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):
 422 \begin{verbatim}
 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
 426 ]
 427 \end{verbatim}
 428
 429 %************************************************************************
 430 %*                                                                      *
 431 \subsubsection[improved-unmixing]{UNIMPLEMENTED idea for improved unmixing}
 432 %*                                                                      *
 433 %************************************************************************
 434
 435 We might be able to optimise unmixing when confronted by
 436 only-one-constructor-possible, of which tuples are the most notable
 437 examples.  Consider:
 438 \begin{verbatim}
 439 f (a,b,c) ... = ...
 440 f d ... (e:f) = ...
 441 f (g,h,i) ... = ...
 442 f j ...       = ...
 443 \end{verbatim}
 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.
 448
 449 You have to be careful, though; the example
 450 \begin{verbatim}
 451 f j ...       = ...
 452 -------------------
 453 f (a,b,c) ... = ...
 454 f d ... (e:f) = ...
 455 f (g,h,i) ... = ...
 456 \end{verbatim}
 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...
 460 \begin{description}
 461 \item[all variables:]
 462 As it is now.
 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).
 467 \end{description}
 468
 469 %************************************************************************
 470 %*                                                                      *
 471 %* match on an unmixed block: the real business                         *
 472 %*                                                                      *
 473 %************************************************************************
 474 \subsection[matchUnmixedEqns]{@matchUnmixedEqns@: getting down to business}
 475
 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@.
 479
 480 \begin{code}
 481 matchUnmixedEqns :: [Id]
 482                   -> [EquationInfo]
 483                   -> [EquationInfo]             -- Shadows
 484                   -> DsM MatchResult
 485
 486 matchUnmixedEqns [] _ _ = panic "matchUnmixedEqns: no names"
 487
 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
 493
 494   | patsAreAllCons column_1_pats        -- ToDo: maybe check just one...
 495   = matchConFamily all_vars eqns_info shadows
 496
 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
 502
 503   where
 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,
 507                                                        irrefutablePat pat ]
 508         -- Discard shadows which can be refuted, since they don't shadow
 509         -- a variable
 510 \end{code}
 511
 512 %************************************************************************
 513 %*                                                                      *
 514 %*  matchWrapper: a convenient way to call @match@                      *
 515 %*                                                                      *
 516 %************************************************************************
 517 \subsection[matchWrapper]{@matchWrapper@: a convenient interface to @match@}
 518
 519 Calls to @match@ often involve similar (non-trivial) work; that work
 520 is collected here, in @matchWrapper@.  This function takes as
 521 arguments:
 522 \begin{itemize}
 523 \item
 524 Typchecked @Matches@ (of a function definition, or a case or lambda
 525 expression)---the main input;
 526 \item
 527 An error message to be inserted into any (runtime) pattern-matching
 528 failure messages.
 529 \end{itemize}
 530
 531 As results, @matchWrapper@ produces:
 532 \begin{itemize}
 533 \item
 534 A list of variables (@Locals@) that the caller must ``promise'' to
 535 bind to appropriate values; and
 536 \item
 537 a @CoreExpr@, the desugared output (main result).
 538 \end{itemize}
 539
 540 The main actions of @matchWrapper@ include:
 541 \begin{enumerate}
 542 \item
 543 Flatten the @[TypecheckedMatch]@ into a suitable list of
 544 @EquationInfo@s.
 545 \item
 546 Create as many new variables as there are patterns in a pattern-list
 547 (in any one of the @EquationInfo@s).
 548 \item
 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.
 552 \item
 553 Call @match@ with all of this information!
 554 \end{enumerate}
 555
 556 \begin{code}
 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
 561
 562 -- a special case for the common ...:
 563 --      just one Match
 564 --      lots of (all?) unfailable pats
 565 --  e.g.,
 566 --      f x y z = ....
 567
 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)
 571
 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)
 576
 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)
 582
 583 ----------------------------------------------------------------------------
 584 -- and all the rest... (general case)
 585
 586 matchWrapper kind matches error_string
 587   = flattenMatches kind matches `thenDs` \ eqns_info@(EqnInfo arg_pats (MatchResult _ result_ty _ _) : _) ->
 588
 589     selectMatchVars arg_pats    `thenDs` \ new_vars ->
 590     match new_vars eqns_info [] `thenDs` \ match_result ->
 591
 592     getSrcLocDs                 `thenDs` \ (src_file, src_line) ->
 593     newSysLocalDs stringTy      `thenDs` \ str_var -> -- to hold the String
 594     let
 595         src_loc_str = escErrorMsg ('"' : src_file) ++ "%l" ++ src_line
 596         fail_expr   = mkErrorApp result_ty str_var (src_loc_str++": "++error_string)
 597     in
 598     extractMatchResult match_result fail_expr   `thenDs` \ result_expr ->
 599     returnDs (new_vars, result_expr)
 600 \end{code}
 601
 602 %************************************************************************
 603 %*                                                                      *
 604 \subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern}
 605 %*                                                                      *
 606 %************************************************************************
 607
 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.
 611
 612 \begin{code}
 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
 618             -> DsM CoreExpr
 619
 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
 623   where
 624     eqn_info = EqnInfo [pat] initial_match_result
 625     initial_match_result = MatchResult CantFail
 626                                        result_ty
 627                                        (\ ignore -> result_expr)
 628                                        NoMatchContext
 629
 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)
 634
 635
 636 extractMatchResult (MatchResult CantFail _ match_fn _) fail_expr
 637   = returnDs (match_fn (error "It can't fail!"))
 638
 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))
 642 \end{code}
 643
 644 %************************************************************************
 645 %*                                                                      *
 646 %*  flattenMatches : create a list of EquationInfo                      *
 647 %*                                                                      *
 648 %************************************************************************
 649 \subsection[flattenMatches]{@flattenMatches@: create @[EquationInfo]@}
 650
 651 This is actually local to @matchWrapper@.
 652
 653 \begin{code}
 654 flattenMatches
 655         :: DsMatchKind
 656         -> [TypecheckedMatch]
 657         -> DsM [EquationInfo]
 658
 659 flattenMatches kind [] = returnDs []
 660
 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)
 665   where
 666     flatten_match :: [TypecheckedPat]           -- Reversed list of patterns encountered so far
 667                   -> TypecheckedMatch
 668                   -> DsM EquationInfo
 669
 670     flatten_match pats_so_far (PatMatch pat match)
 671       = flatten_match (pat:pats_so_far) match
 672
 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))
 677       where
 678         pats = reverse pats_so_far      -- They've accumulated in reverse order
 679 \end{code}