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