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