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