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