ghc/compiler/deSugar/Match.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
   3 %
   4 \section[Main_match]{The @match@ function}
   5
   6 \begin{code}
   7 module Match (
   8         match, matchWrapper, matchSimply
   9     ) where
  10
  11 #include "HsVersions.h"
  12
  13 import AbsSyn           -- the stuff being desugared
  14 import PlainCore        -- the output of desugaring;
  15                         -- importing this module also gets all the
  16                         -- CoreSyn utility functions
  17 import DsMonad          -- the monadery used in the desugarer
  18
  19 import AbsPrel          ( nilDataCon, consDataCon, mkTupleTy, mkListTy,
  20                           charTy, charDataCon, intTy, intDataCon, floatTy,
  21                           floatDataCon, doubleTy, doubleDataCon,
  22                           integerTy, intPrimTy, charPrimTy,
  23                           floatPrimTy, doublePrimTy, mkFunTy, stringTy,
  24                           addrTy, addrPrimTy, addrDataCon,
  25                           wordTy, wordPrimTy, wordDataCon
  26 #ifdef DPH
  27                          ,mkProcessorTy
  28 #endif {- Data Parallel Haskell -}
  29                         )
  30 import PrimKind         ( PrimKind(..) ) -- Rather ugly import; ToDo???
  31
  32 import AbsUniType       ( isPrimType )
  33 import DsBinds          ( dsBinds )
  34 import DsExpr           ( dsExpr )
  35 import DsGRHSs          ( dsGRHSs )
  36 import DsUtils
  37 #ifdef DPH
  38 import Id               ( eqId, getIdUniType, mkTupleCon, mkProcessorCon )
  39 import MatchProc        ( matchProcessor)
  40 #else
  41 import Id               ( eqId, getIdUniType, mkTupleCon, DataCon(..), Id )
  42 #endif {- Data Parallel Haskell -}
  43 import Maybes           ( Maybe(..) )
  44 import MatchCon         ( matchConFamily )
  45 import MatchLit         ( matchLiterals )
  46 import Outputable       -- all for one "panic"...
  47 import Pretty
  48 import Util
  49 \end{code}
  50
  51 The function @match@ is basically the same as in the Wadler chapter,
  52 except it is monadised, to carry around the name supply, info about
  53 annotations, etc.
  54
  55 Notes on @match@'s arguments, assuming $m$ equations and $n$ patterns:
  56 \begin{enumerate}
  57 \item
  58 A list of $n$ variable names, those variables presumably bound to the
  59 $n$ expressions being matched against the $n$ patterns.  Using the
  60 list of $n$ expressions as the first argument showed no benefit and
  61 some inelegance.
  62
  63 \item
  64 The second argument, a list giving the ``equation info'' for each of
  65 the $m$ equations:
  66 \begin{itemize}
  67 \item
  68 the $n$ patterns for that equation, and
  69 \item
  70 a list of Core bindings [@(Id, PlainCoreExpr)@ pairs] to be ``stuck on
  71 the front'' of the matching code, as in:
  72 \begin{verbatim}
  73 let <binds>
  74 in  <matching-code>
  75 \end{verbatim}
  76 \item
  77 and finally: (ToDo: fill in)
  78
  79 The right way to think about the ``after-match function'' is that it
  80 is an embryonic @CoreExpr@ with a ``hole'' at the end for the
  81 final ``else expression''.
  82 \end{itemize}
  83
  84 There is a type synonym, @EquationInfo@, defined in module @DsUtils@.
  85
  86 An experiment with re-ordering this information about equations (in
  87 particular, having the patterns available in column-major order)
  88 showed no benefit.
  89
  90 \item
  91 A default expression---what to evaluate if the overall pattern-match
  92 fails.  This expression will (almost?) always be
  93 a measly expression @CoVar@, unless we know it will only be used once
  94 (as we do in @glue_success_exprs@).
  95
  96 Leaving out this third argument to @match@ (and slamming in lots of
  97 @CoVar "fail"@s) is a positively {\em bad} idea, because it makes it
  98 impossible to share the default expressions.  (Also, it stands no
  99 chance of working in our post-upheaval world of @Locals@.)
 100 \end{enumerate}
 101 So, the full type signature:
 102 \begin{code}
 103 match :: [Id]             -- Variables rep'ing the exprs we're matching with
 104       -> [EquationInfo]   -- Info about patterns, etc. (type synonym below)
 105       -> [EquationInfo]   -- Potentially shadowing equations above this one
 106       -> DsM MatchResult  -- Desugared result!
 107 \end{code}
 108
 109 Note: @match@ is often called via @matchWrapper@ (end of this module),
 110 a function that does much of the house-keeping that goes with a call
 111 to @match@.
 112
 113 It is also worth mentioning the {\em typical} way a block of equations
 114 is desugared with @match@.  At each stage, it is the first column of
 115 patterns that is examined.  The steps carried out are roughly:
 116 \begin{enumerate}
 117 \item
 118 Tidy the patterns in column~1 with @tidyEqnInfo@ (this may add
 119 bindings to the second component of the equation-info):
 120 \begin{itemize}
 121 \item
 122 Remove the `as' patterns from column~1.
 123 \item
 124 Make all constructor patterns in column~1 into @ConPats@, notably
 125 @ListPats@ and @TuplePats@.
 126 \item
 127 Handle any irrefutable (or ``twiddle'') @LazyPats@.
 128 \end{itemize}
 129 \item
 130 Now {\em unmix} the equations into {\em blocks} [w/ local function
 131 @unmix_eqns@], in which the equations in a block all have variable
 132 patterns in column~1, or they all have constructor patterns in ...
 133 (see ``the mixture rule'' in SLPJ).
 134 \item
 135 Call @matchUnmixedEqns@ on each block of equations; it will do the
 136 appropriate thing for each kind of column-1 pattern, usually ending up
 137 in a recursive call to @match@.
 138 \end{enumerate}
 139
 140 %************************************************************************
 141 %*                                                                      *
 142 %*  match: empty rule                                                   *
 143 %*                                                                      *
 144 %************************************************************************
 145 \subsection[Match-empty-rule]{The ``empty rule''}
 146
 147 We are a little more paranoid about the ``empty rule'' (SLPJ, p.~87)
 148 than the Wadler-chapter code for @match@ (p.~93, first @match@ clause).
 149 And gluing the ``success expressions'' together isn't quite so pretty.
 150
 151 \begin{code}
 152 match [] eqns_info shadows
 153   = pin_eqns eqns_info          `thenDs` \ match_result@(MatchResult _ _ _ cxt) ->
 154
 155         -- If at this stage we find that at least one of the shadowing
 156         -- equations is guaranteed not to fail, then warn of an overlapping pattern
 157     if not (all shadow_can_fail shadows) then
 158         dsShadowError cxt       `thenDs` \ _ ->
 159         returnDs match_result
 160     else
 161         returnDs match_result
 162
 163   where
 164     pin_eqns [EqnInfo [] match_result] = returnDs match_result
 165       -- Last eqn... can't have pats ...
 166
 167     pin_eqns (EqnInfo [] match_result1 : more_eqns)
 168       = pin_eqns more_eqns                      `thenDs` \ match_result2 ->
 169         combineMatchResults match_result1 match_result2
 170
 171     pin_eqns other_pat = panic "match: pin_eqns"
 172
 173     shadow_can_fail :: EquationInfo -> Bool
 174
 175     shadow_can_fail (EqnInfo [] (MatchResult CanFail  _ _ _)) = True
 176     shadow_can_fail (EqnInfo [] (MatchResult CantFail _ _ _)) = False
 177     shadow_can_fail other = panic "match:shadow_can_fail"
 178 \end{code}
 179
 180 %************************************************************************
 181 %*                                                                      *
 182 %*  match: non-empty rule                                               *
 183 %*                                                                      *
 184 %************************************************************************
 185 \subsection[Match-nonempty]{@match@ when non-empty: unmixing}
 186
 187 This (more interesting) clause of @match@ uses @tidy_and_unmix_eqns@
 188 (a)~to get `as'- and `twiddle'-patterns out of the way (tidying), and
 189 (b)~to do ``the mixture rule'' (SLPJ, p.~88) [which really {\em
 190 un}mixes the equations], producing a list of equation-info
 191 blocks, each block having as its first column of patterns either all
 192 constructors, or all variables (or similar beasts), etc.
 193
 194 @match_unmixed_eqn_blks@ simply takes the place of the @foldr@ in the
 195 Wadler-chapter @match@ (p.~93, last clause), and @match_unmixed_blk@
 196 corresponds roughly to @matchVarCon@.
 197
 198 \begin{code}
 199 match vars@(v:vs) eqns_info shadows
 200   = mapDs (tidyEqnInfo v) eqns_info     `thenDs` \ tidy_eqns_info ->
 201     mapDs (tidyEqnInfo v) shadows       `thenDs` \ tidy_shadows ->
 202     let
 203         tidy_eqns_blks = unmix_eqns tidy_eqns_info
 204     in
 205     match_unmixed_eqn_blks vars tidy_eqns_blks tidy_shadows
 206   where
 207     unmix_eqns []    = []
 208     unmix_eqns [eqn] = [ [eqn] ]
 209     unmix_eqns (eq1@(EqnInfo (p1:p1s) _) : eq2@(EqnInfo (p2:p2s) _) : eqs)
 210       = if (  (unfailablePat p1 && unfailablePat p2)
 211            || (isConPat      p1 && isConPat p2)
 212            || (isLitPat      p1 && isLitPat p2) ) then
 213             eq1 `tack_onto` unmixed_rest
 214         else
 215             [ eq1 ] : unmixed_rest
 216       where
 217         unmixed_rest = unmix_eqns (eq2:eqs)
 218
 219         x `tack_onto` xss   = ( x : head xss) : tail xss
 220
 221     -----------------------------------------------------------------------
 222     -- loop through the blocks:
 223     -- subsequent blocks create a "fail expr" for the first one...
 224     match_unmixed_eqn_blks :: [Id]
 225                            -> [ [EquationInfo] ]        -- List of eqn BLOCKS
 226                            -> [EquationInfo]            -- Shadows
 227                            -> DsM MatchResult
 228
 229     match_unmixed_eqn_blks vars [] shadows = panic "match_unmixed_eqn_blks"
 230
 231     match_unmixed_eqn_blks vars [eqn_blk] shadows = matchUnmixedEqns vars eqn_blk shadows
 232
 233     match_unmixed_eqn_blks vars (eqn_blk:eqn_blks) shadows
 234       = matchUnmixedEqns vars eqn_blk shadows           `thenDs` \ match_result1 ->  -- try to match with first blk
 235         match_unmixed_eqn_blks vars eqn_blks shadows'   `thenDs` \ match_result2 ->
 236         combineMatchResults match_result1 match_result2
 237       where
 238         shadows' = eqn_blk ++ shadows
 239 \end{code}
 240
 241 Tidy up the leftmost pattern in an @EquationInfo@, given the variable @v@
 242 which will be scrutinised.  This means:
 243 \begin{itemize}
 244 \item
 245 Replace variable patterns @x@ (@x /= v@) with the pattern @_@,
 246 together with the binding @x = v@.
 247 \item
 248 Replace the `as' pattern @x@@p@ with the pattern p and a binding @x = v@.
 249 \item
 250 Removing lazy (irrefutable) patterns (you don't want to know...).
 251 \item
 252 Converting explicit tuple- and list-pats into ordinary @ConPats@.
 253 \end{itemize}
 254
 255 The result of this tidying is that the column of patterns will include
 256 {\em only}:
 257 \begin{description}
 258 \item[@WildPats@:]
 259 The @VarPat@ information isn't needed any more after this.
 260
 261 \item[@ConPats@:]
 262 @ListPats@, @TuplePats@, etc., are all converted into @ConPats@.
 263
 264 \item[@LitPats@ and @NPats@ (and @NPlusKPats@):]
 265 @LitPats@/@NPats@/@NPlusKPats@ of ``known friendly types'' (Int, Char,
 266 Float,  Double, at least) are converted to unboxed form; e.g.,
 267 \tr{(NPat (IntLit i) _ _)} is converted to:
 268 \begin{verbatim}
 269 (ConPat I# _ _ [LitPat (IntPrimLit i) _])
 270 \end{verbatim}
 271 \end{description}
 272
 273 \begin{code}
 274 tidyEqnInfo :: Id -> EquationInfo -> DsM EquationInfo
 275         -- DsM'd because of internal call to "match".
 276         -- "tidy1" does the interesting stuff, looking at
 277         -- one pattern and fiddling the list of bindings.
 278 tidyEqnInfo v (EqnInfo (pat : pats) match_result)
 279   = tidy1 v pat match_result    `thenDs` \ (pat', match_result') ->
 280     returnDs (EqnInfo (pat' : pats) match_result')
 281
 282 tidy1 :: Id                                     -- The Id being scrutinised
 283       -> TypecheckedPat                         -- The pattern against which it is to be matched
 284       -> MatchResult                            -- Current thing do do after matching
 285       -> DsM (TypecheckedPat,                   -- Equivalent pattern
 286               MatchResult)                      -- Augmented thing to do afterwards
 287                                                 -- The augmentation usually takes the form
 288                                                 -- of new bindings to be added to the front
 289
 290 tidy1 v (VarPat var) match_result
 291   = returnDs (WildPat (getIdUniType var),
 292               mkCoLetsMatchResult extra_binds match_result)
 293   where
 294     extra_binds | v `eqId` var = []
 295                 | otherwise    = [CoNonRec var (CoVar v)]
 296
 297 tidy1 v (AsPat var pat) match_result
 298   = tidy1 v pat (mkCoLetsMatchResult extra_binds match_result)
 299   where
 300     extra_binds | v `eqId` var = []
 301                 | otherwise    = [CoNonRec var (CoVar v)]
 302
 303 tidy1 v (WildPat ty) match_result
 304   = returnDs (WildPat ty, match_result)
 305
 306 {- now, here we handle lazy patterns:
 307     tidy1 v ~p bs = (v, v1 = case v of p -> v1 :
 308                         v2 = case v of p -> v2 : ... : bs )
 309
 310     where the v_i's are the binders in the pattern.
 311
 312     ToDo: in "v_i = ... -> v_i", are the v_i's really the same thing?
 313
 314     The case expr for v_i is just: match [v] [(p, [], \ x -> CoVar v_i)] any_expr
 315 -}
 316
 317 tidy1 v (LazyPat pat) match_result
 318   = mkSelectorBinds [] pat l_to_l (CoVar v)     `thenDs` \ sel_binds ->
 319     returnDs (WildPat (getIdUniType v),
 320               mkCoLetsMatchResult [CoNonRec b rhs | (b,rhs) <- sel_binds] match_result)
 321   where
 322     l_to_l = binders `zip` binders      -- Boring
 323     binders = collectTypedPatBinders pat
 324
 325 -- re-express <con-something> as (ConPat ...) [directly]
 326
 327 tidy1 v (ConOpPat pat1 id pat2 ty) match_result
 328   = returnDs (ConPat id ty [pat1, pat2], match_result)
 329
 330 tidy1 v (ListPat ty pats) match_result
 331   = returnDs (list_ConPat, match_result)
 332   where
 333     list_ty = mkListTy ty
 334     list_ConPat
 335       = foldr (\ x -> \y -> ConPat consDataCon list_ty [x, y])
 336               (ConPat nilDataCon  list_ty [])
 337               pats
 338
 339 tidy1 v (TuplePat pats) match_result
 340   = returnDs (tuple_ConPat, match_result)
 341   where
 342     arity = length pats
 343     tuple_ConPat
 344       = ConPat (mkTupleCon arity)
 345                (mkTupleTy arity (map typeOfPat pats))
 346                pats
 347
 348 #ifdef DPH
 349 tidy1 v (ProcessorPat pats convs pat) match_result
 350   = returnDs ((ProcessorPat pats convs pat), match_result)
 351 {-
 352 tidy1 v (ProcessorPat pats _ _ pat) match_result
 353   = returnDs (processor_ConPat, match_result)
 354   where
 355     processor_ConPat
 356       = ConPat (mkProcessorCon (length pats))
 357                (mkProcessorTy (map typeOfPat pats) (typeOfPat pat))
 358                (pats++[pat])
 359 -}
 360 #endif {- Data Parallel Haskell -}
 361
 362 -- deeply ugly mangling for some (common) NPats/LitPats
 363
 364 -- LitPats: the desugarer only sees these at well-known types
 365
 366 tidy1 v pat@(LitPat lit lit_ty) match_result
 367   | isPrimType lit_ty
 368   = returnDs (pat, match_result)
 369
 370   | lit_ty == charTy
 371   = returnDs (ConPat charDataCon charTy [LitPat (mk_char lit) charPrimTy],
 372               match_result)
 373
 374   | otherwise = pprPanic "tidy1:LitPat:" (ppr PprDebug pat)
 375   where
 376     mk_char (CharLit c)    = CharPrimLit c
 377
 378 -- NPats: we *might* be able to replace these w/ a simpler form
 379
 380 tidy1 v pat@(NPat lit lit_ty _) match_result
 381   = returnDs (better_pat, match_result)
 382   where
 383     better_pat
 384       | lit_ty == charTy   = ConPat charDataCon   lit_ty [LitPat (mk_char lit)   charPrimTy]
 385       | lit_ty == intTy    = ConPat intDataCon    lit_ty [LitPat (mk_int lit)    intPrimTy]
 386       | lit_ty == wordTy   = ConPat wordDataCon   lit_ty [LitPat (mk_word lit)   wordPrimTy]
 387       | lit_ty == addrTy   = ConPat addrDataCon   lit_ty [LitPat (mk_addr lit)   addrPrimTy]
 388       | lit_ty == floatTy  = ConPat floatDataCon  lit_ty [LitPat (mk_float lit)  floatPrimTy]
 389       | lit_ty == doubleTy = ConPat doubleDataCon lit_ty [LitPat (mk_double lit) doublePrimTy]
 390       | otherwise          = pat
 391
 392     mk_int    (IntLit i) = IntPrimLit i
 393     mk_int    l@(LitLitLit s _) = l
 394
 395     mk_char   (CharLit c)= CharPrimLit c
 396     mk_char   l@(LitLitLit s _) = l
 397
 398     mk_word   l@(LitLitLit s _) = l
 399
 400     mk_addr   l@(LitLitLit s _) = l
 401
 402     mk_float  (IntLit i) = FloatPrimLit (fromInteger i)
 403 #if __GLASGOW_HASKELL__ <= 22
 404     mk_float  (FracLit f)= FloatPrimLit (fromRational f) -- ToDo???
 405 #else
 406     mk_float  (FracLit f)= FloatPrimLit f
 407 #endif
 408     mk_float  l@(LitLitLit s _) = l
 409
 410     mk_double (IntLit i) = DoublePrimLit (fromInteger i)
 411 #if __GLASGOW_HASKELL__ <= 22
 412     mk_double (FracLit f)= DoublePrimLit (fromRational f) -- ToDo???
 413 #else
 414     mk_double (FracLit f)= DoublePrimLit f
 415 #endif
 416     mk_double l@(LitLitLit s _) = l
 417
 418 {- OLD: and wrong!  I don't think we can do anything
 419    useful with n+k patterns, so drop through to default case
 420
 421 tidy1 v pat@(NPlusKPat n k lit_ty and so on) match_result
 422   = returnDs (NPlusKPat v k lit_ty and so on,
 423               (if v `eqId` n then id else (mkCoLet (CoNonRec n (CoVar v)))) . match_result)
 424 -}
 425
 426 -- and everything else goes through unchanged...
 427
 428 tidy1 v non_interesting_pat match_result
 429   = returnDs (non_interesting_pat, match_result)
 430 \end{code}
 431
 432 PREVIOUS matchTwiddled STUFF:
 433
 434 Now we get to the only interesting part; note: there are choices for
 435 translation [from Simon's notes]; translation~1:
 436 \begin{verbatim}
 437 deTwiddle [s,t] e
 438 \end{verbatim}
 439 returns
 440 \begin{verbatim}
 441 [ w = e,
 442   s = case w of [s,t] -> s
 443   t = case w of [s,t] -> t
 444 ]
 445 \end{verbatim}
 446
 447 Here \tr{w} is a fresh variable, and the \tr{w}-binding prevents multiple
 448 evaluation of \tr{e}.  An alternative translation (No.~2):
 449 \begin{verbatim}
 450 [ w = case e of [s,t] -> (s,t)
 451   s = case w of (s,t) -> s
 452   t = case w of (s,t) -> t
 453 ]
 454 \end{verbatim}
 455
 456 %************************************************************************
 457 %*                                                                      *
 458 \subsubsection[improved-unmixing]{UNIMPLEMENTED idea for improved unmixing}
 459 %*                                                                      *
 460 %************************************************************************
 461
 462 We might be able to optimise unmixing when confronted by
 463 only-one-constructor-possible, of which tuples are the most notable
 464 examples.  Consider:
 465 \begin{verbatim}
 466 f (a,b,c) ... = ...
 467 f d ... (e:f) = ...
 468 f (g,h,i) ... = ...
 469 f j ...       = ...
 470 \end{verbatim}
 471 This definition would normally be unmixed into four equation blocks,
 472 one per equation.  But it could be unmixed into just one equation
 473 block, because if the one equation matches (on the first column),
 474 the others certainly will.
 475
 476 You have to be careful, though; the example
 477 \begin{verbatim}
 478 f j ...       = ...
 479 -------------------
 480 f (a,b,c) ... = ...
 481 f d ... (e:f) = ...
 482 f (g,h,i) ... = ...
 483 \end{verbatim}
 484 {\em must} be broken into two blocks at the line shown; otherwise, you
 485 are forcing unnecessary evaluation.  In any case, the top-left pattern
 486 always gives the cue.  You could then unmix blocks into groups of...
 487 \begin{description}
 488 \item[all variables:]
 489 As it is now.
 490 \item[constructors or variables (mixed):]
 491 Need to make sure the right names get bound for the variable patterns.
 492 \item[literals or variables (mixed):]
 493 Presumably just a variant on the constructor case (as it is now).
 494 \end{description}
 495
 496 %************************************************************************
 497 %*                                                                      *
 498 %* match on an unmixed block: the real business                         *
 499 %*                                                                      *
 500 %************************************************************************
 501 \subsection[matchUnmixedEqns]{@matchUnmixedEqns@: getting down to business}
 502
 503 The function @matchUnmixedEqns@ is where the matching stuff sets to
 504 work a block of equations, to which the mixture rule has been applied.
 505 Its arguments and results are the same as for the ``top-level'' @match@.
 506
 507 \begin{code}
 508 matchUnmixedEqns :: [Id]
 509                   -> [EquationInfo]
 510                   -> [EquationInfo]             -- Shadows
 511                   -> DsM MatchResult
 512
 513 matchUnmixedEqns [] _ _ = panic "matchUnmixedEqns: no names"
 514
 515 matchUnmixedEqns all_vars@(var:vars) eqns_info shadows
 516   | unfailablePats column_1_pats        -- Could check just one; we know they've been tidied, unmixed;
 517                                         -- this way is (arguably) a sanity-check
 518   =     -- Real true variables, just like in matchVar, SLPJ p 94
 519     match vars remaining_eqns_info remaining_shadows
 520
 521 #ifdef DPH
 522   | patsAreAllProcessor column_1_pats
 523   =     -- ToDo: maybe check just one...
 524     matchProcessor all_vars eqns_info
 525 #endif {- Data Parallel Haskell -}
 526
 527   | patsAreAllCons column_1_pats        -- ToDo: maybe check just one...
 528   = matchConFamily all_vars eqns_info shadows
 529
 530   | patsAreAllLits column_1_pats        -- ToDo: maybe check just one...
 531   =     -- see notes in MatchLiteral
 532         -- not worried about the same literal more than once in a column
 533         -- (ToDo: sort this out later)
 534     matchLiterals all_vars eqns_info shadows
 535
 536   where
 537     column_1_pats       = [pat                       | EqnInfo (pat:_)  _            <- eqns_info]
 538     remaining_eqns_info = [EqnInfo pats match_result | EqnInfo (_:pats) match_result <- eqns_info]
 539     remaining_shadows   = [EqnInfo pats match_result | EqnInfo (pat:pats) match_result <- shadows,
 540                                                        irrefutablePat pat ]
 541         -- Discard shadows which can be refuted, since they don't shadow
 542         -- a variable
 543 \end{code}
 544
 545 %************************************************************************
 546 %*                                                                      *
 547 %*  matchWrapper: a convenient way to call @match@                      *
 548 %*                                                                      *
 549 %************************************************************************
 550 \subsection[matchWrapper]{@matchWrapper@: a convenient interface to @match@}
 551
 552 Calls to @match@ often involve similar (non-trivial) work; that work
 553 is collected here, in @matchWrapper@.  This function takes as
 554 arguments:
 555 \begin{itemize}
 556 \item
 557 Typchecked @Matches@ (of a function definition, or a case or lambda
 558 expression)---the main input;
 559 \item
 560 An error message to be inserted into any (runtime) pattern-matching
 561 failure messages.
 562 \end{itemize}
 563
 564 As results, @matchWrapper@ produces:
 565 \begin{itemize}
 566 \item
 567 A list of variables (@Locals@) that the caller must ``promise'' to
 568 bind to appropriate values; and
 569 \item
 570 a @PlainCoreExpr@, the desugared output (main result).
 571 \end{itemize}
 572
 573 The main actions of @matchWrapper@ include:
 574 \begin{enumerate}
 575 \item
 576 Flatten the @[TypecheckedMatch]@ into a suitable list of
 577 @EquationInfo@s.
 578 \item
 579 Create as many new variables as there are patterns in a pattern-list
 580 (in any one of the @EquationInfo@s).
 581 \item
 582 Create a suitable ``if it fails'' expression---a call to @error@ using
 583 the error-string input; the {\em type} of this fail value can be found
 584 by examining one of the RHS expressions in one of the @EquationInfo@s.
 585 \item
 586 Call @match@ with all of this information!
 587 \end{enumerate}
 588
 589 \begin{code}
 590 matchWrapper :: DsMatchKind                     -- For shadowing warning messages
 591              -> [TypecheckedMatch]              -- Matches being desugared
 592              -> String                          -- Error message if the match fails
 593              -> DsM ([Id], PlainCoreExpr)       -- Results
 594
 595 -- a special case for the common ...:
 596 --      just one Match
 597 --      lots of (all?) unfailable pats
 598 --  e.g.,
 599 --      f x y z = ....
 600
 601 matchWrapper kind [(PatMatch (VarPat var) match)] error_string
 602   = matchWrapper kind [match] error_string `thenDs` \ (vars, core_expr) ->
 603     returnDs (var:vars, core_expr)
 604
 605 matchWrapper kind [(PatMatch (WildPat ty) match)] error_string
 606   = newSysLocalDs ty                  `thenDs` \ var ->
 607     matchWrapper kind [match] error_string `thenDs` \ (vars, core_expr) ->
 608     returnDs (var:vars, core_expr)
 609
 610 matchWrapper kind [(GRHSMatch
 611                      (GRHSsAndBindsOut [OtherwiseGRHS expr _] binds _))] error_string
 612   = dsBinds binds       `thenDs` \ core_binds ->
 613     dsExpr  expr        `thenDs` \ core_expr ->
 614     returnDs ([], mkCoLetsAny core_binds core_expr)
 615
 616 ----------------------------------------------------------------------------
 617 -- and all the rest... (general case)
 618
 619 matchWrapper kind matches error_string
 620   = flattenMatches kind matches `thenDs` \ eqns_info@(EqnInfo arg_pats (MatchResult _ result_ty _ _) : _) ->
 621
 622     selectMatchVars arg_pats    `thenDs` \ new_vars ->
 623     match new_vars eqns_info [] `thenDs` \ match_result ->
 624
 625     getSrcLocDs                 `thenDs` \ (src_file, src_line) ->
 626     newSysLocalDs stringTy      `thenDs` \ str_var -> -- to hold the String
 627     let
 628         src_loc_str = escErrorMsg ('"' : src_file) ++ "%l" ++ src_line
 629         fail_expr   = mkErrorCoApp result_ty str_var (src_loc_str++": "++error_string)
 630     in
 631     extractMatchResult match_result fail_expr   `thenDs` \ result_expr ->
 632     returnDs (new_vars, result_expr)
 633 \end{code}
 634
 635 %************************************************************************
 636 %*                                                                      *
 637 \subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern}
 638 %*                                                                      *
 639 %************************************************************************
 640
 641 @mkSimpleMatch@ is a wrapper for @match@ which deals with the
 642 situation where we want to match a single expression against a single
 643 pattern. It returns an expression.
 644
 645 \begin{code}
 646 matchSimply :: PlainCoreExpr                    -- Scrutinee
 647             -> TypecheckedPat                   -- Pattern it should match
 648             -> UniType                          -- Type of result
 649             -> PlainCoreExpr                    -- Return this if it matches
 650             -> PlainCoreExpr                    -- Return this if it does
 651             -> DsM PlainCoreExpr
 652
 653 matchSimply (CoVar var) pat result_ty result_expr fail_expr
 654   = match [var] [eqn_info] []   `thenDs` \ match_result ->
 655     extractMatchResult match_result fail_expr
 656   where
 657     eqn_info = EqnInfo [pat] initial_match_result
 658     initial_match_result = MatchResult CantFail
 659                                        result_ty
 660                                        (\ ignore -> result_expr)
 661                                        NoMatchContext
 662
 663 matchSimply scrut_expr pat result_ty result_expr msg
 664   = newSysLocalDs (typeOfPat pat)                               `thenDs` \ scrut_var ->
 665     matchSimply (CoVar scrut_var) pat result_ty result_expr msg `thenDs` \ expr ->
 666     returnDs (CoLet (CoNonRec scrut_var scrut_expr) expr)
 667
 668
 669 extractMatchResult (MatchResult CantFail _ match_fn _) fail_expr
 670   = returnDs (match_fn (error "It can't fail!"))
 671
 672 extractMatchResult (MatchResult CanFail result_ty match_fn _) fail_expr
 673   = mkFailurePair result_ty     `thenDs` \ (fail_bind_fn, if_it_fails) ->
 674     returnDs (CoLet (fail_bind_fn fail_expr) (match_fn if_it_fails))
 675 \end{code}
 676
 677 %************************************************************************
 678 %*                                                                      *
 679 %*  flattenMatches : create a list of EquationInfo                      *
 680 %*                                                                      *
 681 %************************************************************************
 682 \subsection[flattenMatches]{@flattenMatches@: create @[EquationInfo]@}
 683
 684 This is actually local to @matchWrapper@.
 685
 686 \begin{code}
 687 flattenMatches
 688         :: DsMatchKind
 689         -> [TypecheckedMatch]
 690         -> DsM [EquationInfo]
 691
 692 flattenMatches kind [] = returnDs []
 693
 694 flattenMatches kind (match : matches)
 695   = flatten_match [] match      `thenDs` \ eqn_info ->
 696     flattenMatches kind matches `thenDs` \ eqn_infos ->
 697     returnDs (eqn_info : eqn_infos)
 698   where
 699     flatten_match :: [TypecheckedPat]           -- Reversed list of patterns encountered so far
 700                   -> TypecheckedMatch
 701                   -> DsM EquationInfo
 702
 703     flatten_match pats_so_far (PatMatch pat match)
 704       = flatten_match (pat:pats_so_far) match
 705
 706     flatten_match pats_so_far (GRHSMatch (GRHSsAndBindsOut grhss binds ty))
 707       = dsBinds binds                           `thenDs` \ core_binds ->
 708         dsGRHSs ty kind pats grhss              `thenDs` \ match_result ->
 709         returnDs (EqnInfo pats (mkCoLetsMatchResult core_binds match_result))
 710       where
 711         pats = reverse pats_so_far      -- They've accumulated in reverse order
 712 \end{code}