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