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 CoreUtils        ( coreExprType )
  22 import DsMonad
  23 import DsGRHSs          ( dsGRHSs )
  24 import DsUtils
  25 import MatchCon         ( matchConFamily )
  26 import MatchLit         ( matchLiterals )
  27
  28 import FieldLabel       ( allFieldLabelTags, fieldLabelTag )
  29 import Id               ( idType, mkTupleCon, dataConSig,
  30                           dataConArgTys, recordSelectorFieldLabel,
  31                           GenId{-instance-}
  32                         )
  33 import PprStyle         ( PprStyle(..) )
  34 import PprType          ( GenType{-instance-}, GenTyVar{-ditto-} )
  35 import PrelInfo         ( nilDataCon, consDataCon, mkTupleTy, mkListTy,
  36                           charTy, charDataCon, intTy, intDataCon,
  37                           floatTy, floatDataCon, doubleTy, doubleDataCon,
  38                           integerTy, intPrimTy, charPrimTy,
  39                           floatPrimTy, doublePrimTy, stringTy,
  40                           addrTy, addrPrimTy, addrDataCon,
  41                           wordTy, wordPrimTy, wordDataCon,
  42                           pAT_ERROR_ID
  43                         )
  44 import Type             ( isPrimType, eqTy, getAppDataTyCon,
  45                           instantiateTauTy
  46                         )
  47 import TyVar            ( GenTyVar{-instance Eq-} )
  48 import Unique           ( Unique{-instance Eq-} )
  49 import Util             ( panic, pprPanic, assertPanic )
  50 \end{code}
  51
  52 The function @match@ is basically the same as in the Wadler chapter,
  53 except it is monadised, to carry around the name supply, info about
  54 annotations, etc.
  55
  56 Notes on @match@'s arguments, assuming $m$ equations and $n$ patterns:
  57 \begin{enumerate}
  58 \item
  59 A list of $n$ variable names, those variables presumably bound to the
  60 $n$ expressions being matched against the $n$ patterns.  Using the
  61 list of $n$ expressions as the first argument showed no benefit and
  62 some inelegance.
  63
  64 \item
  65 The second argument, a list giving the ``equation info'' for each of
  66 the $m$ equations:
  67 \begin{itemize}
  68 \item
  69 the $n$ patterns for that equation, and
  70 \item
  71 a list of Core bindings [@(Id, CoreExpr)@ pairs] to be ``stuck on
  72 the front'' of the matching code, as in:
  73 \begin{verbatim}
  74 let <binds>
  75 in  <matching-code>
  76 \end{verbatim}
  77 \item
  78 and finally: (ToDo: fill in)
  79
  80 The right way to think about the ``after-match function'' is that it
  81 is an embryonic @CoreExpr@ with a ``hole'' at the end for the
  82 final ``else expression''.
  83 \end{itemize}
  84
  85 There is a type synonym, @EquationInfo@, defined in module @DsUtils@.
  86
  87 An experiment with re-ordering this information about equations (in
  88 particular, having the patterns available in column-major order)
  89 showed no benefit.
  90
  91 \item
  92 A default expression---what to evaluate if the overall pattern-match
  93 fails.  This expression will (almost?) always be
  94 a measly expression @Var@, unless we know it will only be used once
  95 (as we do in @glue_success_exprs@).
  96
  97 Leaving out this third argument to @match@ (and slamming in lots of
  98 @Var "fail"@s) is a positively {\em bad} idea, because it makes it
  99 impossible to share the default expressions.  (Also, it stands no
 100 chance of working in our post-upheaval world of @Locals@.)
 101 \end{enumerate}
 102 So, the full type signature:
 103 \begin{code}
 104 match :: [Id]             -- Variables rep'ing the exprs we're matching with
 105       -> [EquationInfo]   -- Info about patterns, etc. (type synonym below)
 106       -> [EquationInfo]   -- Potentially shadowing equations above this one
 107       -> DsM MatchResult  -- Desugared result!
 108 \end{code}
 109
 110 Note: @match@ is often called via @matchWrapper@ (end of this module),
 111 a function that does much of the house-keeping that goes with a call
 112 to @match@.
 113
 114 It is also worth mentioning the {\em typical} way a block of equations
 115 is desugared with @match@.  At each stage, it is the first column of
 116 patterns that is examined.  The steps carried out are roughly:
 117 \begin{enumerate}
 118 \item
 119 Tidy the patterns in column~1 with @tidyEqnInfo@ (this may add
 120 bindings to the second component of the equation-info):
 121 \begin{itemize}
 122 \item
 123 Remove the `as' patterns from column~1.
 124 \item
 125 Make all constructor patterns in column~1 into @ConPats@, notably
 126 @ListPats@ and @TuplePats@.
 127 \item
 128 Handle any irrefutable (or ``twiddle'') @LazyPats@.
 129 \end{itemize}
 130 \item
 131 Now {\em unmix} the equations into {\em blocks} [w/ local function
 132 @unmix_eqns@], in which the equations in a block all have variable
 133 patterns in column~1, or they all have constructor patterns in ...
 134 (see ``the mixture rule'' in SLPJ).
 135 \item
 136 Call @matchUnmixedEqns@ on each block of equations; it will do the
 137 appropriate thing for each kind of column-1 pattern, usually ending up
 138 in a recursive call to @match@.
 139 \end{enumerate}
 140
 141 %************************************************************************
 142 %*                                                                      *
 143 %*  match: empty rule                                                   *
 144 %*                                                                      *
 145 %************************************************************************
 146 \subsection[Match-empty-rule]{The ``empty rule''}
 147
 148 We are a little more paranoid about the ``empty rule'' (SLPJ, p.~87)
 149 than the Wadler-chapter code for @match@ (p.~93, first @match@ clause).
 150 And gluing the ``success expressions'' together isn't quite so pretty.
 151
 152 \begin{code}
 153 match [] eqns_info shadows
 154   = pin_eqns eqns_info          `thenDs` \ match_result@(MatchResult _ _ _ cxt) ->
 155
 156         -- If at this stage we find that at least one of the shadowing
 157         -- equations is guaranteed not to fail, then warn of an overlapping pattern
 158     if not (all shadow_can_fail shadows) then
 159         dsShadowError cxt       `thenDs` \ _ ->
 160         returnDs match_result
 161     else
 162         returnDs match_result
 163
 164   where
 165     pin_eqns [EqnInfo [] match_result] = returnDs match_result
 166       -- Last eqn... can't have pats ...
 167
 168     pin_eqns (EqnInfo [] match_result1 : more_eqns)
 169       = pin_eqns more_eqns                      `thenDs` \ match_result2 ->
 170         combineMatchResults match_result1 match_result2
 171
 172     pin_eqns other_pat = panic "match: pin_eqns"
 173
 174     shadow_can_fail :: EquationInfo -> Bool
 175
 176     shadow_can_fail (EqnInfo [] (MatchResult CanFail  _ _ _)) = True
 177     shadow_can_fail (EqnInfo [] (MatchResult CantFail _ _ _)) = False
 178     shadow_can_fail other = panic "match:shadow_can_fail"
 179 \end{code}
 180
 181 %************************************************************************
 182 %*                                                                      *
 183 %*  match: non-empty rule                                               *
 184 %*                                                                      *
 185 %************************************************************************
 186 \subsection[Match-nonempty]{@match@ when non-empty: unmixing}
 187
 188 This (more interesting) clause of @match@ uses @tidy_and_unmix_eqns@
 189 (a)~to get `as'- and `twiddle'-patterns out of the way (tidying), and
 190 (b)~to do ``the mixture rule'' (SLPJ, p.~88) [which really {\em
 191 un}mixes the equations], producing a list of equation-info
 192 blocks, each block having as its first column of patterns either all
 193 constructors, or all variables (or similar beasts), etc.
 194
 195 @match_unmixed_eqn_blks@ simply takes the place of the @foldr@ in the
 196 Wadler-chapter @match@ (p.~93, last clause), and @match_unmixed_blk@
 197 corresponds roughly to @matchVarCon@.
 198
 199 \begin{code}
 200 match vars@(v:vs) eqns_info shadows
 201   = mapDs (tidyEqnInfo v) eqns_info     `thenDs` \ tidy_eqns_info ->
 202     mapDs (tidyEqnInfo v) shadows       `thenDs` \ tidy_shadows ->
 203     let
 204         tidy_eqns_blks = unmix_eqns tidy_eqns_info
 205     in
 206     match_unmixed_eqn_blks vars tidy_eqns_blks tidy_shadows
 207   where
 208     unmix_eqns []    = []
 209     unmix_eqns [eqn] = [ [eqn] ]
 210     unmix_eqns (eq1@(EqnInfo (p1:p1s) _) : eq2@(EqnInfo (p2:p2s) _) : eqs)
 211       = if (  (unfailablePat p1 && unfailablePat p2)
 212            || (isConPat      p1 && isConPat p2)
 213            || (isLitPat      p1 && isLitPat p2) ) then
 214             eq1 `tack_onto` unmixed_rest
 215         else
 216             [ eq1 ] : unmixed_rest
 217       where
 218         unmixed_rest = unmix_eqns (eq2:eqs)
 219
 220         x `tack_onto` xss   = ( x : head xss) : tail xss
 221
 222     -----------------------------------------------------------------------
 223     -- loop through the blocks:
 224     -- subsequent blocks create a "fail expr" for the first one...
 225     match_unmixed_eqn_blks :: [Id]
 226                            -> [ [EquationInfo] ]        -- List of eqn BLOCKS
 227                            -> [EquationInfo]            -- Shadows
 228                            -> DsM MatchResult
 229
 230     match_unmixed_eqn_blks vars [] shadows = panic "match_unmixed_eqn_blks"
 231
 232     match_unmixed_eqn_blks vars [eqn_blk] shadows = matchUnmixedEqns vars eqn_blk shadows
 233
 234     match_unmixed_eqn_blks vars (eqn_blk:eqn_blks) shadows
 235       = matchUnmixedEqns vars eqn_blk shadows           `thenDs` \ match_result1 ->  -- try to match with first blk
 236         match_unmixed_eqn_blks vars eqn_blks shadows'   `thenDs` \ match_result2 ->
 237         combineMatchResults match_result1 match_result2
 238       where
 239         shadows' = eqn_blk ++ shadows
 240 \end{code}
 241
 242 Tidy up the leftmost pattern in an @EquationInfo@, given the variable @v@
 243 which will be scrutinised.  This means:
 244 \begin{itemize}
 245 \item
 246 Replace variable patterns @x@ (@x /= v@) with the pattern @_@,
 247 together with the binding @x = v@.
 248 \item
 249 Replace the `as' pattern @x@@p@ with the pattern p and a binding @x = v@.
 250 \item
 251 Removing lazy (irrefutable) patterns (you don't want to know...).
 252 \item
 253 Converting explicit tuple- and list-pats into ordinary @ConPats@.
 254 \end{itemize}
 255
 256 The result of this tidying is that the column of patterns will include
 257 {\em only}:
 258 \begin{description}
 259 \item[@WildPats@:]
 260 The @VarPat@ information isn't needed any more after this.
 261
 262 \item[@ConPats@:]
 263 @ListPats@, @TuplePats@, etc., are all converted into @ConPats@.
 264
 265 \item[@LitPats@ and @NPats@:]
 266 @LitPats@/@NPats@ of ``known friendly types'' (Int, Char,
 267 Float,  Double, at least) are converted to unboxed form; e.g.,
 268 \tr{(NPat (HsInt i) _ _)} is converted to:
 269 \begin{verbatim}
 270 (ConPat I# _ _ [LitPat (HsIntPrim i) _])
 271 \end{verbatim}
 272 \end{description}
 273
 274 \begin{code}
 275 tidyEqnInfo :: Id -> EquationInfo -> DsM EquationInfo
 276         -- DsM'd because of internal call to "match".
 277         -- "tidy1" does the interesting stuff, looking at
 278         -- one pattern and fiddling the list of bindings.
 279 tidyEqnInfo v (EqnInfo (pat : pats) match_result)
 280   = tidy1 v pat match_result    `thenDs` \ (pat', match_result') ->
 281     returnDs (EqnInfo (pat' : pats) match_result')
 282
 283 tidy1 :: Id                                     -- The Id being scrutinised
 284       -> TypecheckedPat                         -- The pattern against which it is to be matched
 285       -> MatchResult                            -- Current thing do do after matching
 286       -> DsM (TypecheckedPat,                   -- Equivalent pattern
 287               MatchResult)                      -- Augmented thing to do afterwards
 288                                                 -- The augmentation usually takes the form
 289                                                 -- of new bindings to be added to the front
 290
 291 tidy1 v (VarPat var) match_result
 292   = returnDs (WildPat (idType var),
 293               mkCoLetsMatchResult extra_binds match_result)
 294   where
 295     extra_binds | v == var  = []
 296                 | otherwise = [NonRec var (Var v)]
 297
 298 tidy1 v (AsPat var pat) match_result
 299   = tidy1 v pat (mkCoLetsMatchResult extra_binds match_result)
 300   where
 301     extra_binds | v == var  = []
 302                 | otherwise = [NonRec var (Var v)]
 303
 304 tidy1 v (WildPat ty) match_result
 305   = returnDs (WildPat ty, match_result)
 306
 307 {- now, here we handle lazy patterns:
 308     tidy1 v ~p bs = (v, v1 = case v of p -> v1 :
 309                         v2 = case v of p -> v2 : ... : bs )
 310
 311     where the v_i's are the binders in the pattern.
 312
 313     ToDo: in "v_i = ... -> v_i", are the v_i's really the same thing?
 314
 315     The case expr for v_i is just: match [v] [(p, [], \ x -> Var v_i)] any_expr
 316 -}
 317
 318 tidy1 v (LazyPat pat) match_result
 319   = mkSelectorBinds [] pat l_to_l (Var v)       `thenDs` \ sel_binds ->
 320     returnDs (WildPat (idType v),
 321               mkCoLetsMatchResult [NonRec b rhs | (b,rhs) <- sel_binds] match_result)
 322   where
 323     l_to_l = binders `zip` binders      -- Boring
 324     binders = collectTypedPatBinders pat
 325
 326 -- re-express <con-something> as (ConPat ...) [directly]
 327
 328 tidy1 v (ConOpPat pat1 id pat2 ty) match_result
 329   = returnDs (ConPat id ty [pat1, pat2], match_result)
 330
 331 tidy1 v (RecPat con_id pat_ty rpats) match_result
 332   = returnDs (ConPat con_id pat_ty pats, match_result)
 333   where
 334     pats             = map mk_pat tagged_arg_tys
 335
 336         -- Boring stuff to find the arg-tys of the constructor
 337     (_, inst_tys, _) = getAppDataTyCon pat_ty
 338     con_arg_tys'     = dataConArgTys con_id inst_tys
 339     tagged_arg_tys   = con_arg_tys' `zip` allFieldLabelTags
 340
 341         -- mk_pat picks a WildPat of the appropriate type for absent fields,
 342         -- and the specified pattern for present fields
 343     mk_pat (arg_ty, tag) = case [pat | (sel_id,pat,_) <- rpats,
 344                                         fieldLabelTag (recordSelectorFieldLabel sel_id) == tag
 345                                 ] of
 346                                 (pat:pats) -> ASSERT( null pats )
 347                                               pat
 348                                 []         -> WildPat arg_ty
 349
 350 tidy1 v (ListPat ty pats) match_result
 351   = returnDs (list_ConPat, match_result)
 352   where
 353     list_ty = mkListTy ty
 354     list_ConPat
 355       = foldr (\ x -> \y -> ConPat consDataCon list_ty [x, y])
 356               (ConPat nilDataCon  list_ty [])
 357               pats
 358
 359 tidy1 v (TuplePat pats) match_result
 360   = returnDs (tuple_ConPat, match_result)
 361   where
 362     arity = length pats
 363     tuple_ConPat
 364       = ConPat (mkTupleCon arity)
 365                (mkTupleTy arity (map outPatType pats))
 366                pats
 367
 368 tidy1 v (DictPat dicts methods) match_result
 369   = case num_of_d_and_ms of
 370         0 -> tidy1 v (TuplePat []) match_result
 371         1 -> tidy1 v (head dict_and_method_pats) match_result
 372         _ -> tidy1 v (TuplePat dict_and_method_pats) match_result
 373   where
 374     num_of_d_and_ms      = length dicts + length methods
 375     dict_and_method_pats = map VarPat (dicts ++ methods)
 376
 377
 378 -- deeply ugly mangling for some (common) NPats/LitPats
 379
 380 -- LitPats: the desugarer only sees these at well-known types
 381
 382 tidy1 v pat@(LitPat lit lit_ty) match_result
 383   | isPrimType lit_ty
 384   = returnDs (pat, match_result)
 385
 386   | lit_ty `eqTy` charTy
 387   = returnDs (ConPat charDataCon charTy [LitPat (mk_char lit) charPrimTy],
 388               match_result)
 389
 390   | otherwise = pprPanic "tidy1:LitPat:" (ppr PprDebug pat)
 391   where
 392     mk_char (HsChar c)    = HsCharPrim c
 393
 394 -- NPats: we *might* be able to replace these w/ a simpler form
 395
 396 tidy1 v pat@(NPat lit lit_ty _) match_result
 397   = returnDs (better_pat, match_result)
 398   where
 399     better_pat
 400       | lit_ty `eqTy` charTy   = ConPat charDataCon   lit_ty [LitPat (mk_char lit)   charPrimTy]
 401       | lit_ty `eqTy` intTy    = ConPat intDataCon    lit_ty [LitPat (mk_int lit)    intPrimTy]
 402       | lit_ty `eqTy` wordTy   = ConPat wordDataCon   lit_ty [LitPat (mk_word lit)   wordPrimTy]
 403       | lit_ty `eqTy` addrTy   = ConPat addrDataCon   lit_ty [LitPat (mk_addr lit)   addrPrimTy]
 404       | lit_ty `eqTy` floatTy  = ConPat floatDataCon  lit_ty [LitPat (mk_float lit)  floatPrimTy]
 405       | lit_ty `eqTy` doubleTy = ConPat doubleDataCon lit_ty [LitPat (mk_double lit) doublePrimTy]
 406       | otherwise          = pat
 407
 408     mk_int    (HsInt i)      = HsIntPrim i
 409     mk_int    l@(HsLitLit s) = l
 410
 411     mk_char   (HsChar c)     = HsCharPrim c
 412     mk_char   l@(HsLitLit s) = l
 413
 414     mk_word   l@(HsLitLit s) = l
 415
 416     mk_addr   l@(HsLitLit s) = l
 417
 418     mk_float  (HsInt i)      = HsFloatPrim (fromInteger i)
 419     mk_float  (HsFrac f)     = HsFloatPrim f
 420     mk_float  l@(HsLitLit s) = l
 421
 422     mk_double (HsInt i)      = HsDoublePrim (fromInteger i)
 423     mk_double (HsFrac f)     = HsDoublePrim f
 424     mk_double l@(HsLitLit s) = l
 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   | patsAreAllCons column_1_pats        -- ToDo: maybe check just one...
 522   = matchConFamily all_vars eqns_info shadows
 523
 524   | patsAreAllLits column_1_pats        -- ToDo: maybe check just one...
 525   =     -- see notes in MatchLiteral
 526         -- not worried about the same literal more than once in a column
 527         -- (ToDo: sort this out later)
 528     matchLiterals all_vars eqns_info shadows
 529
 530   where
 531     column_1_pats       = [pat                       | EqnInfo (pat:_)  _            <- eqns_info]
 532     remaining_eqns_info = [EqnInfo pats match_result | EqnInfo (_:pats) match_result <- eqns_info]
 533     remaining_shadows   = [EqnInfo pats match_result | EqnInfo (pat:pats) match_result <- shadows,
 534                                                        irrefutablePat pat ]
 535         -- Discard shadows which can be refuted, since they don't shadow
 536         -- a variable
 537 \end{code}
 538
 539 %************************************************************************
 540 %*                                                                      *
 541 %*  matchWrapper: a convenient way to call @match@                      *
 542 %*                                                                      *
 543 %************************************************************************
 544 \subsection[matchWrapper]{@matchWrapper@: a convenient interface to @match@}
 545
 546 Calls to @match@ often involve similar (non-trivial) work; that work
 547 is collected here, in @matchWrapper@.  This function takes as
 548 arguments:
 549 \begin{itemize}
 550 \item
 551 Typchecked @Matches@ (of a function definition, or a case or lambda
 552 expression)---the main input;
 553 \item
 554 An error message to be inserted into any (runtime) pattern-matching
 555 failure messages.
 556 \end{itemize}
 557
 558 As results, @matchWrapper@ produces:
 559 \begin{itemize}
 560 \item
 561 A list of variables (@Locals@) that the caller must ``promise'' to
 562 bind to appropriate values; and
 563 \item
 564 a @CoreExpr@, the desugared output (main result).
 565 \end{itemize}
 566
 567 The main actions of @matchWrapper@ include:
 568 \begin{enumerate}
 569 \item
 570 Flatten the @[TypecheckedMatch]@ into a suitable list of
 571 @EquationInfo@s.
 572 \item
 573 Create as many new variables as there are patterns in a pattern-list
 574 (in any one of the @EquationInfo@s).
 575 \item
 576 Create a suitable ``if it fails'' expression---a call to @error@ using
 577 the error-string input; the {\em type} of this fail value can be found
 578 by examining one of the RHS expressions in one of the @EquationInfo@s.
 579 \item
 580 Call @match@ with all of this information!
 581 \end{enumerate}
 582
 583 \begin{code}
 584 matchWrapper :: DsMatchKind                     -- For shadowing warning messages
 585              -> [TypecheckedMatch]              -- Matches being desugared
 586              -> String                          -- Error message if the match fails
 587              -> DsM ([Id], CoreExpr)    -- Results
 588
 589 -- a special case for the common ...:
 590 --      just one Match
 591 --      lots of (all?) unfailable pats
 592 --  e.g.,
 593 --      f x y z = ....
 594
 595 matchWrapper kind [(PatMatch (VarPat var) match)] error_string
 596   = matchWrapper kind [match] error_string `thenDs` \ (vars, core_expr) ->
 597     returnDs (var:vars, core_expr)
 598
 599 matchWrapper kind [(PatMatch (WildPat ty) match)] error_string
 600   = newSysLocalDs ty                  `thenDs` \ var ->
 601     matchWrapper kind [match] error_string `thenDs` \ (vars, core_expr) ->
 602     returnDs (var:vars, core_expr)
 603
 604 matchWrapper kind [(GRHSMatch
 605                      (GRHSsAndBindsOut [OtherwiseGRHS expr _] binds _))] error_string
 606   = dsBinds binds       `thenDs` \ core_binds ->
 607     dsExpr  expr        `thenDs` \ core_expr ->
 608     returnDs ([], mkCoLetsAny core_binds core_expr)
 609
 610 ----------------------------------------------------------------------------
 611 -- and all the rest... (general case)
 612
 613 matchWrapper kind matches error_string
 614   = flattenMatches kind matches `thenDs` \ eqns_info@(EqnInfo arg_pats (MatchResult _ result_ty _ _) : _) ->
 615
 616     selectMatchVars arg_pats                            `thenDs` \ new_vars ->
 617     match new_vars eqns_info []                         `thenDs` \ match_result ->
 618
 619     mkErrorAppDs pAT_ERROR_ID result_ty error_string    `thenDs` \ fail_expr ->
 620     extractMatchResult match_result fail_expr           `thenDs` \ result_expr ->
 621
 622     returnDs (new_vars, result_expr)
 623 \end{code}
 624
 625 %************************************************************************
 626 %*                                                                      *
 627 \subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern}
 628 %*                                                                      *
 629 %************************************************************************
 630
 631 @mkSimpleMatch@ is a wrapper for @match@ which deals with the
 632 situation where we want to match a single expression against a single
 633 pattern. It returns an expression.
 634
 635 \begin{code}
 636 matchSimply :: CoreExpr                 -- Scrutinee
 637             -> TypecheckedPat                   -- Pattern it should match
 638             -> Type                             -- Type of result
 639             -> CoreExpr                 -- Return this if it matches
 640             -> CoreExpr                 -- Return this if it does
 641             -> DsM CoreExpr
 642
 643 matchSimply (Var var) pat result_ty result_expr fail_expr
 644   = match [var] [eqn_info] []   `thenDs` \ match_result ->
 645     extractMatchResult match_result fail_expr
 646   where
 647     eqn_info = EqnInfo [pat] initial_match_result
 648     initial_match_result = MatchResult CantFail
 649                                        result_ty
 650                                        (\ ignore -> result_expr)
 651                                        NoMatchContext
 652
 653 matchSimply scrut_expr pat result_ty result_expr msg
 654   = newSysLocalDs (outPatType pat)                              `thenDs` \ scrut_var ->
 655     matchSimply (Var scrut_var) pat result_ty result_expr msg   `thenDs` \ expr ->
 656     returnDs (Let (NonRec scrut_var scrut_expr) expr)
 657
 658
 659 extractMatchResult (MatchResult CantFail _ match_fn _) fail_expr
 660   = returnDs (match_fn (error "It can't fail!"))
 661
 662 extractMatchResult (MatchResult CanFail result_ty match_fn _) fail_expr
 663   = mkFailurePair result_ty     `thenDs` \ (fail_bind_fn, if_it_fails) ->
 664     returnDs (Let (fail_bind_fn fail_expr) (match_fn if_it_fails))
 665 \end{code}
 666
 667 %************************************************************************
 668 %*                                                                      *
 669 %*  flattenMatches : create a list of EquationInfo                      *
 670 %*                                                                      *
 671 %************************************************************************
 672 \subsection[flattenMatches]{@flattenMatches@: create @[EquationInfo]@}
 673
 674 This is actually local to @matchWrapper@.
 675
 676 \begin{code}
 677 flattenMatches
 678         :: DsMatchKind
 679         -> [TypecheckedMatch]
 680         -> DsM [EquationInfo]
 681
 682 flattenMatches kind [] = returnDs []
 683
 684 flattenMatches kind (match : matches)
 685   = flatten_match [] match      `thenDs` \ eqn_info ->
 686     flattenMatches kind matches `thenDs` \ eqn_infos ->
 687     returnDs (eqn_info : eqn_infos)
 688   where
 689     flatten_match :: [TypecheckedPat]           -- Reversed list of patterns encountered so far
 690                   -> TypecheckedMatch
 691                   -> DsM EquationInfo
 692
 693     flatten_match pats_so_far (PatMatch pat match)
 694       = flatten_match (pat:pats_so_far) match
 695
 696     flatten_match pats_so_far (GRHSMatch (GRHSsAndBindsOut grhss binds ty))
 697       = dsBinds binds                           `thenDs` \ core_binds ->
 698         dsGRHSs ty kind pats grhss              `thenDs` \ match_result ->
 699         returnDs (EqnInfo pats (mkCoLetsMatchResult core_binds match_result))
 700       where
 701         pats = reverse pats_so_far      -- They've accumulated in reverse order
 702
 703     flatten_match pats_so_far (SimpleMatch expr)
 704       = dsExpr expr             `thenDs` \ core_expr ->
 705         returnDs (EqnInfo pats
 706                     (MatchResult CantFail (coreExprType core_expr)
 707                               (\ ignore -> core_expr)
 708                               NoMatchContext))
 709         -- The NoMatchContext is just a place holder.  In a simple match,
 710         -- the matching can't fail, so we won't generate an error message.
 711       where
 712         pats = reverse pats_so_far      -- They've accumulated in reverse order
 713 \end{code}