ghc/compiler/deSugar/Match.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[Main_match]{The @match@ function}
   5
   6 \begin{code}
   7 module Match ( match, matchExport, matchWrapper, matchSimply, matchSinglePat ) where
   8
   9 #include "HsVersions.h"
  10
  11 import {-# SOURCE #-} DsExpr  ( dsExpr, dsLet  )
  12
  13 import CmdLineOpts      ( opt_WarnIncompletePatterns, opt_WarnOverlappingPatterns,
  14                           opt_WarnSimplePatterns
  15                         )
  16 import HsSyn
  17 import TcHsSyn          ( TypecheckedPat, TypecheckedMatch )
  18 import DsHsSyn          ( outPatType )
  19 import Check            ( check, ExhaustivePat )
  20 import CoreSyn
  21 import CoreUtils        ( bindNonRec )
  22 import DsMonad
  23 import DsGRHSs          ( dsGRHSs )
  24 import DsUtils
  25 import Id               ( idType, recordSelectorFieldLabel, Id )
  26 import DataCon          ( dataConFieldLabels, dataConArgTys )
  27 import MatchCon         ( matchConFamily )
  28 import MatchLit         ( matchLiterals )
  29 import PrelInfo         ( pAT_ERROR_ID )
  30 import Type             ( isUnLiftedType, splitAlgTyConApp,
  31                           mkTyVarTys, Type
  32                         )
  33 import TysPrim          ( intPrimTy, charPrimTy, floatPrimTy, doublePrimTy,
  34                           addrPrimTy, wordPrimTy
  35                         )
  36 import TysWiredIn       ( nilDataCon, consDataCon, mkTupleTy, mkListTy,
  37                           charTy, charDataCon, intTy, intDataCon,
  38                           floatTy, floatDataCon, doubleTy, tupleCon,
  39                           doubleDataCon, addrTy,
  40                           addrDataCon, wordTy, wordDataCon,
  41                           mkUnboxedTupleTy, unboxedTupleCon
  42                         )
  43 import UniqSet
  44 import ErrUtils         ( addErrLocHdrLine, dontAddErrLoc )
  45 import Outputable
  46 \end{code}
  47
  48 This function is a wrapper of @match@, it must be called from all the parts where
  49 it was called match, but only substitutes the firs call, ....
  50 if the associated flags are declared, warnings will be issued.
  51 It can not be called matchWrapper because this name already exists :-(
  52
  53 JJCQ 30-Nov-1997
  54
  55 \begin{code}
  56 matchExport :: [Id]             -- Vars rep'ing the exprs we're matching with
  57             -> [EquationInfo]   -- Info about patterns, etc. (type synonym below)
  58             -> DsM MatchResult  -- Desugared result!
  59
  60 matchExport vars qs@((EqnInfo _ ctx _ (MatchResult _ _)) : _)
  61   | incomplete && shadow =
  62       dsShadowWarn ctx eqns_shadow              `thenDs`   \ () ->
  63       dsIncompleteWarn ctx pats                 `thenDs`   \ () ->
  64       match vars qs
  65   | incomplete            =
  66       dsIncompleteWarn ctx pats                 `thenDs`   \ () ->
  67       match vars qs
  68   | shadow                =
  69       dsShadowWarn ctx eqns_shadow              `thenDs`   \ () ->
  70       match vars qs
  71   | otherwise             =
  72       match vars qs
  73   where (pats,indexs) = check qs
  74         incomplete    = opt_WarnIncompletePatterns && (length pats /= 0)
  75         shadow        = opt_WarnOverlappingPatterns && sizeUniqSet indexs < no_eqns
  76         no_eqns       = length qs
  77         unused_eqns   = uniqSetToList (mkUniqSet [1..no_eqns] `minusUniqSet` indexs)
  78         eqns_shadow   = map (\n -> qs!!(n - 1)) unused_eqns
  79 \end{code}
  80
  81 This variable shows the maximum number of lines of output generated for warnings.
  82 It will limit the number of patterns/equations displayed to@ maximum_output@.
  83
  84 (ToDo: add command-line option?)
  85
  86 \begin{code}
  87 maximum_output = 4
  88 \end{code}
  89
  90 The next two functions create the warning message.
  91
  92 \begin{code}
  93 dsShadowWarn :: DsMatchContext -> [EquationInfo] -> DsM ()
  94 dsShadowWarn ctx@(DsMatchContext kind _ _) qs = dsWarn warn
  95         where
  96           warn | length qs > maximum_output
  97                = pp_context ctx (ptext SLIT("are overlapped"))
  98                             (\ f -> vcat (map (ppr_eqn f kind) (take maximum_output qs)) $$
  99                             ptext SLIT("..."))
 100                | otherwise
 101                = pp_context ctx (ptext SLIT("are overlapped"))
 102                             (\ f -> vcat $ map (ppr_eqn f kind) qs)
 103
 104
 105 dsIncompleteWarn :: DsMatchContext -> [ExhaustivePat] -> DsM ()
 106 dsIncompleteWarn ctx@(DsMatchContext kind _ _) pats = dsWarn warn
 107         where
 108           warn = pp_context ctx (ptext SLIT("are non-exhaustive"))
 109                             (\f -> hang (ptext SLIT("Patterns not matched:"))
 110                                    4 ((vcat $ map (ppr_incomplete_pats kind)
 111                                                   (take maximum_output pats))
 112                                       $$ dots))
 113
 114           dots | length pats > maximum_output = ptext SLIT("...")
 115                | otherwise                    = empty
 116
 117 pp_context NoMatchContext msg rest_of_msg_fun
 118   = dontAddErrLoc "" (ptext SLIT("Some match(es)") <+> hang msg 8 (rest_of_msg_fun id))
 119
 120 pp_context (DsMatchContext kind pats loc) msg rest_of_msg_fun
 121   = case pp_match kind pats of
 122       (ppr_match, pref) ->
 123           addErrLocHdrLine loc message (nest 8 (rest_of_msg_fun pref))
 124         where
 125           message = ptext SLIT("Pattern match(es)") <+> msg <+> ppr_match <> char ':'
 126  where
 127     pp_match (FunMatch fun) pats
 128       = let ppr_fun = ppr fun in
 129         ( hsep [ptext SLIT("in the definition of function"), quotes ppr_fun]
 130         , (\ x -> ppr_fun <+> x)
 131         )
 132
 133     pp_match CaseMatch pats
 134       = (hang (ptext SLIT("in a group of case alternatives beginning"))
 135            4 (ppr_pats pats)
 136         , id
 137         )
 138
 139     pp_match RecUpdMatch pats
 140       = (hang (ptext SLIT("in a record-update construct"))
 141            4 (ppr_pats pats)
 142         , id
 143         )
 144
 145     pp_match PatBindMatch pats
 146       = ( hang (ptext SLIT("in a pattern binding"))
 147             4 (ppr_pats pats)
 148         , id
 149         )
 150
 151     pp_match LambdaMatch pats
 152       = ( hang (ptext SLIT("in a lambda abstraction"))
 153             4 (ppr_pats pats)
 154         , id
 155         )
 156
 157     pp_match DoBindMatch pats
 158       = ( hang (ptext SLIT("in a `do' pattern binding"))
 159              4 (ppr_pats pats)
 160         , id
 161         )
 162
 163     pp_match ListCompMatch pats
 164       = ( hang (ptext SLIT("in a `list comprension' pattern binding"))
 165              4 (ppr_pats pats)
 166         , id
 167         )
 168
 169     pp_match LetMatch pats
 170       = ( hang (ptext SLIT("in a `let' pattern binding"))
 171              4 (ppr_pats pats)
 172         , id
 173         )
 174
 175 ppr_pats pats = sep (map ppr pats)
 176
 177 separator (FunMatch _)    = SLIT("=")
 178 separator (CaseMatch)     = SLIT("->")
 179 separator (LambdaMatch)   = SLIT("->")
 180 separator (PatBindMatch)  = panic "When is this used?"
 181 separator (RecUpdMatch)   = panic "When is this used?"
 182 separator (DoBindMatch)   = SLIT("<-")
 183 separator (ListCompMatch) = SLIT("<-")
 184 separator (LetMatch)      = SLIT("=")
 185
 186 ppr_shadow_pats kind pats
 187   = sep [ppr_pats pats, ptext (separator kind), ptext SLIT("...")]
 188
 189 ppr_incomplete_pats kind (pats,[]) = ppr_pats pats
 190 ppr_incomplete_pats kind (pats,constraints) =
 191                          sep [ppr_pats pats, ptext SLIT("with"),
 192                               sep (map ppr_constraint constraints)]
 193
 194
 195 ppr_constraint (var,pats) = sep [ppr var, ptext SLIT("`notElem`"), ppr pats]
 196
 197 ppr_eqn prefixF kind (EqnInfo _ _ pats _) = prefixF (ppr_shadow_pats kind pats)
 198 \end{code}
 199
 200
 201 The function @match@ is basically the same as in the Wadler chapter,
 202 except it is monadised, to carry around the name supply, info about
 203 annotations, etc.
 204
 205 Notes on @match@'s arguments, assuming $m$ equations and $n$ patterns:
 206 \begin{enumerate}
 207 \item
 208 A list of $n$ variable names, those variables presumably bound to the
 209 $n$ expressions being matched against the $n$ patterns.  Using the
 210 list of $n$ expressions as the first argument showed no benefit and
 211 some inelegance.
 212
 213 \item
 214 The second argument, a list giving the ``equation info'' for each of
 215 the $m$ equations:
 216 \begin{itemize}
 217 \item
 218 the $n$ patterns for that equation, and
 219 \item
 220 a list of Core bindings [@(Id, CoreExpr)@ pairs] to be ``stuck on
 221 the front'' of the matching code, as in:
 222 \begin{verbatim}
 223 let <binds>
 224 in  <matching-code>
 225 \end{verbatim}
 226 \item
 227 and finally: (ToDo: fill in)
 228
 229 The right way to think about the ``after-match function'' is that it
 230 is an embryonic @CoreExpr@ with a ``hole'' at the end for the
 231 final ``else expression''.
 232 \end{itemize}
 233
 234 There is a type synonym, @EquationInfo@, defined in module @DsUtils@.
 235
 236 An experiment with re-ordering this information about equations (in
 237 particular, having the patterns available in column-major order)
 238 showed no benefit.
 239
 240 \item
 241 A default expression---what to evaluate if the overall pattern-match
 242 fails.  This expression will (almost?) always be
 243 a measly expression @Var@, unless we know it will only be used once
 244 (as we do in @glue_success_exprs@).
 245
 246 Leaving out this third argument to @match@ (and slamming in lots of
 247 @Var "fail"@s) is a positively {\em bad} idea, because it makes it
 248 impossible to share the default expressions.  (Also, it stands no
 249 chance of working in our post-upheaval world of @Locals@.)
 250 \end{enumerate}
 251 So, the full type signature:
 252 \begin{code}
 253 match :: [Id]             -- Variables rep'ing the exprs we're matching with
 254       -> [EquationInfo]   -- Info about patterns, etc. (type synonym below)
 255       -> DsM MatchResult  -- Desugared result!
 256 \end{code}
 257
 258 Note: @match@ is often called via @matchWrapper@ (end of this module),
 259 a function that does much of the house-keeping that goes with a call
 260 to @match@.
 261
 262 It is also worth mentioning the {\em typical} way a block of equations
 263 is desugared with @match@.  At each stage, it is the first column of
 264 patterns that is examined.  The steps carried out are roughly:
 265 \begin{enumerate}
 266 \item
 267 Tidy the patterns in column~1 with @tidyEqnInfo@ (this may add
 268 bindings to the second component of the equation-info):
 269 \begin{itemize}
 270 \item
 271 Remove the `as' patterns from column~1.
 272 \item
 273 Make all constructor patterns in column~1 into @ConPats@, notably
 274 @ListPats@ and @TuplePats@.
 275 \item
 276 Handle any irrefutable (or ``twiddle'') @LazyPats@.
 277 \end{itemize}
 278 \item
 279 Now {\em unmix} the equations into {\em blocks} [w/ local function
 280 @unmix_eqns@], in which the equations in a block all have variable
 281 patterns in column~1, or they all have constructor patterns in ...
 282 (see ``the mixture rule'' in SLPJ).
 283 \item
 284 Call @matchUnmixedEqns@ on each block of equations; it will do the
 285 appropriate thing for each kind of column-1 pattern, usually ending up
 286 in a recursive call to @match@.
 287 \end{enumerate}
 288
 289 %************************************************************************
 290 %*                                                                      *
 291 %*  match: empty rule                                                   *
 292 %*                                                                      *
 293 %************************************************************************
 294 \subsection[Match-empty-rule]{The ``empty rule''}
 295
 296 We are a little more paranoid about the ``empty rule'' (SLPJ, p.~87)
 297 than the Wadler-chapter code for @match@ (p.~93, first @match@ clause).
 298 And gluing the ``success expressions'' together isn't quite so pretty.
 299
 300 \begin{code}
 301 match [] eqns_info
 302   = complete_matches eqns_info
 303   where
 304     complete_matches [eqn]
 305         = complete_match eqn
 306
 307     complete_matches (eqn:eqns)
 308         = complete_match eqn            `thenDs` \ match_result1 ->
 309           complete_matches eqns         `thenDs` \ match_result2 ->
 310           returnDs (combineMatchResults match_result1 match_result2)
 311
 312     complete_match (EqnInfo _ _ pats match_result)
 313         = ASSERT( null pats )
 314           returnDs match_result
 315 \end{code}
 316
 317 %************************************************************************
 318 %*                                                                      *
 319 %*  match: non-empty rule                                               *
 320 %*                                                                      *
 321 %************************************************************************
 322 \subsection[Match-nonempty]{@match@ when non-empty: unmixing}
 323
 324 This (more interesting) clause of @match@ uses @tidy_and_unmix_eqns@
 325 (a)~to get `as'- and `twiddle'-patterns out of the way (tidying), and
 326 (b)~to do ``the mixture rule'' (SLPJ, p.~88) [which really {\em
 327 un}mixes the equations], producing a list of equation-info
 328 blocks, each block having as its first column of patterns either all
 329 constructors, or all variables (or similar beasts), etc.
 330
 331 @match_unmixed_eqn_blks@ simply takes the place of the @foldr@ in the
 332 Wadler-chapter @match@ (p.~93, last clause), and @match_unmixed_blk@
 333 corresponds roughly to @matchVarCon@.
 334
 335 \begin{code}
 336 match vars@(v:vs) eqns_info
 337   = mapDs (tidyEqnInfo v) eqns_info     `thenDs` \ tidy_eqns_info ->
 338     let
 339         tidy_eqns_blks = unmix_eqns tidy_eqns_info
 340     in
 341     match_unmixed_eqn_blks vars tidy_eqns_blks
 342   where
 343     unmix_eqns []    = []
 344     unmix_eqns [eqn] = [ [eqn] ]
 345     unmix_eqns (eq1@(EqnInfo _ _ (p1:p1s) _) : eq2@(EqnInfo _ _ (p2:p2s) _) : eqs)
 346       = if (  (isWildPat p1 && isWildPat p2)
 347            || (isConPat  p1 && isConPat  p2)
 348            || (isLitPat  p1 && isLitPat  p2) ) then
 349             eq1 `tack_onto` unmixed_rest
 350         else
 351             [ eq1 ] : unmixed_rest
 352       where
 353         unmixed_rest = unmix_eqns (eq2:eqs)
 354
 355         x `tack_onto` xss   = ( x : head xss) : tail xss
 356
 357     -----------------------------------------------------------------------
 358     -- loop through the blocks:
 359     -- subsequent blocks create a "fail expr" for the first one...
 360     match_unmixed_eqn_blks :: [Id]
 361                            -> [ [EquationInfo] ]        -- List of eqn BLOCKS
 362                            -> DsM MatchResult
 363
 364     match_unmixed_eqn_blks vars [] = panic "match_unmixed_eqn_blks"
 365
 366     match_unmixed_eqn_blks vars [eqn_blk] = matchUnmixedEqns vars eqn_blk
 367
 368     match_unmixed_eqn_blks vars (eqn_blk:eqn_blks)
 369       = matchUnmixedEqns vars eqn_blk           `thenDs` \ match_result1 ->  -- try to match with first blk
 370         match_unmixed_eqn_blks vars eqn_blks    `thenDs` \ match_result2 ->
 371         returnDs (combineMatchResults match_result1 match_result2)
 372 \end{code}
 373
 374 Tidy up the leftmost pattern in an @EquationInfo@, given the variable @v@
 375 which will be scrutinised.  This means:
 376 \begin{itemize}
 377 \item
 378 Replace variable patterns @x@ (@x /= v@) with the pattern @_@,
 379 together with the binding @x = v@.
 380 \item
 381 Replace the `as' pattern @x@@p@ with the pattern p and a binding @x = v@.
 382 \item
 383 Removing lazy (irrefutable) patterns (you don't want to know...).
 384 \item
 385 Converting explicit tuple- and list-pats into ordinary @ConPats@.
 386 \item
 387 Convert the literal pat "" to [].
 388 \end{itemize}
 389
 390 The result of this tidying is that the column of patterns will include
 391 {\em only}:
 392 \begin{description}
 393 \item[@WildPats@:]
 394 The @VarPat@ information isn't needed any more after this.
 395
 396 \item[@ConPats@:]
 397 @ListPats@, @TuplePats@, etc., are all converted into @ConPats@.
 398
 399 \item[@LitPats@ and @NPats@:]
 400 @LitPats@/@NPats@ of ``known friendly types'' (Int, Char,
 401 Float,  Double, at least) are converted to unboxed form; e.g.,
 402 \tr{(NPat (HsInt i) _ _)} is converted to:
 403 \begin{verbatim}
 404 (ConPat I# _ _ [LitPat (HsIntPrim i) _])
 405 \end{verbatim}
 406 \end{description}
 407
 408 \begin{code}
 409 tidyEqnInfo :: Id -> EquationInfo -> DsM EquationInfo
 410         -- DsM'd because of internal call to "match".
 411         -- "tidy1" does the interesting stuff, looking at
 412         -- one pattern and fiddling the list of bindings.
 413         --
 414         -- POST CONDITION: head pattern in the EqnInfo is
 415         --      WildPat
 416         --      ConPat
 417         --      NPat
 418         --      LitPat
 419         --      NPlusKPat
 420         -- but no other
 421
 422 tidyEqnInfo v (EqnInfo n ctx (pat : pats) match_result)
 423   = tidy1 v pat match_result    `thenDs` \ (pat', match_result') ->
 424     returnDs (EqnInfo n ctx (pat' : pats) match_result')
 425
 426 tidy1 :: Id                                     -- The Id being scrutinised
 427       -> TypecheckedPat                         -- The pattern against which it is to be matched
 428       -> MatchResult                            -- Current thing do do after matching
 429       -> DsM (TypecheckedPat,                   -- Equivalent pattern
 430               MatchResult)                      -- Augmented thing to do afterwards
 431                                                 -- The augmentation usually takes the form
 432                                                 -- of new bindings to be added to the front
 433
 434 tidy1 v (VarPat var) match_result
 435   = returnDs (WildPat (idType var), match_result')
 436   where
 437     match_result' | v == var  = match_result
 438                   | otherwise = adjustMatchResult (bindNonRec var (Var v)) match_result
 439
 440 tidy1 v (AsPat var pat) match_result
 441   = tidy1 v pat match_result'
 442   where
 443     match_result' | v == var  = match_result
 444                   | otherwise = adjustMatchResult (bindNonRec var (Var v)) match_result
 445
 446 tidy1 v (WildPat ty) match_result
 447   = returnDs (WildPat ty, match_result)
 448
 449 {- now, here we handle lazy patterns:
 450     tidy1 v ~p bs = (v, v1 = case v of p -> v1 :
 451                         v2 = case v of p -> v2 : ... : bs )
 452
 453     where the v_i's are the binders in the pattern.
 454
 455     ToDo: in "v_i = ... -> v_i", are the v_i's really the same thing?
 456
 457     The case expr for v_i is just: match [v] [(p, [], \ x -> Var v_i)] any_expr
 458 -}
 459
 460 tidy1 v (LazyPat pat) match_result
 461   = mkSelectorBinds pat (Var v)         `thenDs` \ sel_binds ->
 462     returnDs (WildPat (idType v),
 463               mkCoLetsMatchResult [NonRec b rhs | (b,rhs) <- sel_binds] match_result)
 464
 465 -- re-express <con-something> as (ConPat ...) [directly]
 466
 467 tidy1 v (RecPat data_con pat_ty ex_tvs dicts rpats) match_result
 468   | null rpats
 469   =     -- Special case for C {}, which can be used for
 470         -- a constructor that isn't declared to have
 471         -- fields at all
 472     returnDs (ConPat data_con pat_ty ex_tvs dicts (map WildPat con_arg_tys'), match_result)
 473
 474   | otherwise
 475   = returnDs (ConPat data_con pat_ty ex_tvs dicts pats, match_result)
 476   where
 477     pats             = map mk_pat tagged_arg_tys
 478
 479         -- Boring stuff to find the arg-tys of the constructor
 480     (_, inst_tys, _) = splitAlgTyConApp pat_ty
 481     con_arg_tys'     = dataConArgTys data_con (inst_tys ++ mkTyVarTys ex_tvs)
 482     tagged_arg_tys   = con_arg_tys' `zip` (dataConFieldLabels data_con)
 483
 484         -- mk_pat picks a WildPat of the appropriate type for absent fields,
 485         -- and the specified pattern for present fields
 486     mk_pat (arg_ty, lbl) = case [pat | (sel_id,pat,_) <- rpats,
 487                                         recordSelectorFieldLabel sel_id == lbl
 488                                 ] of
 489                                 (pat:pats) -> ASSERT( null pats )
 490                                               pat
 491                                 []         -> WildPat arg_ty
 492
 493 tidy1 v (ListPat ty pats) match_result
 494   = returnDs (list_ConPat, match_result)
 495   where
 496     list_ty = mkListTy ty
 497     list_ConPat
 498       = foldr (\ x -> \y -> ConPat consDataCon list_ty [] [] [x, y])
 499               (ConPat nilDataCon  list_ty [] [] [])
 500               pats
 501
 502 tidy1 v (TuplePat pats True{-boxed-}) match_result
 503   = returnDs (tuple_ConPat, match_result)
 504   where
 505     arity = length pats
 506     tuple_ConPat
 507       = ConPat (tupleCon arity)
 508                (mkTupleTy arity (map outPatType pats)) [] []
 509                pats
 510
 511 tidy1 v (TuplePat pats False{-unboxed-}) match_result
 512   = returnDs (tuple_ConPat, match_result)
 513   where
 514     arity = length pats
 515     tuple_ConPat
 516       = ConPat (unboxedTupleCon arity)
 517                (mkUnboxedTupleTy arity (map outPatType pats)) [] []
 518                pats
 519
 520 tidy1 v (DictPat dicts methods) match_result
 521   = case num_of_d_and_ms of
 522         0 -> tidy1 v (TuplePat [] True) match_result
 523         1 -> tidy1 v (head dict_and_method_pats) match_result
 524         _ -> tidy1 v (TuplePat dict_and_method_pats True) match_result
 525   where
 526     num_of_d_and_ms      = length dicts + length methods
 527     dict_and_method_pats = map VarPat (dicts ++ methods)
 528
 529
 530 -- deeply ugly mangling for some (common) NPats/LitPats
 531
 532 -- LitPats: the desugarer only sees these at well-known types
 533
 534 tidy1 v pat@(LitPat lit lit_ty) match_result
 535   = returnDs (tidyLitPat lit lit_ty pat, match_result)
 536
 537 -- NPats: we *might* be able to replace these w/ a simpler form
 538 tidy1 v pat@(NPat lit lit_ty _) match_result
 539   = returnDs (tidyLitPat lit lit_ty pat, match_result)
 540
 541 -- and everything else goes through unchanged...
 542
 543 tidy1 v non_interesting_pat match_result
 544   = returnDs (non_interesting_pat, match_result)
 545 \end{code}
 546
 547 \noindent
 548 {\bf Previous @matchTwiddled@ stuff:}
 549
 550 Now we get to the only interesting part; note: there are choices for
 551 translation [from Simon's notes]; translation~1:
 552 \begin{verbatim}
 553 deTwiddle [s,t] e
 554 \end{verbatim}
 555 returns
 556 \begin{verbatim}
 557 [ w = e,
 558   s = case w of [s,t] -> s
 559   t = case w of [s,t] -> t
 560 ]
 561 \end{verbatim}
 562
 563 Here \tr{w} is a fresh variable, and the \tr{w}-binding prevents multiple
 564 evaluation of \tr{e}.  An alternative translation (No.~2):
 565 \begin{verbatim}
 566 [ w = case e of [s,t] -> (s,t)
 567   s = case w of (s,t) -> s
 568   t = case w of (s,t) -> t
 569 ]
 570 \end{verbatim}
 571
 572 %************************************************************************
 573 %*                                                                      *
 574 \subsubsection[improved-unmixing]{UNIMPLEMENTED idea for improved unmixing}
 575 %*                                                                      *
 576 %************************************************************************
 577
 578 We might be able to optimise unmixing when confronted by
 579 only-one-constructor-possible, of which tuples are the most notable
 580 examples.  Consider:
 581 \begin{verbatim}
 582 f (a,b,c) ... = ...
 583 f d ... (e:f) = ...
 584 f (g,h,i) ... = ...
 585 f j ...       = ...
 586 \end{verbatim}
 587 This definition would normally be unmixed into four equation blocks,
 588 one per equation.  But it could be unmixed into just one equation
 589 block, because if the one equation matches (on the first column),
 590 the others certainly will.
 591
 592 You have to be careful, though; the example
 593 \begin{verbatim}
 594 f j ...       = ...
 595 -------------------
 596 f (a,b,c) ... = ...
 597 f d ... (e:f) = ...
 598 f (g,h,i) ... = ...
 599 \end{verbatim}
 600 {\em must} be broken into two blocks at the line shown; otherwise, you
 601 are forcing unnecessary evaluation.  In any case, the top-left pattern
 602 always gives the cue.  You could then unmix blocks into groups of...
 603 \begin{description}
 604 \item[all variables:]
 605 As it is now.
 606 \item[constructors or variables (mixed):]
 607 Need to make sure the right names get bound for the variable patterns.
 608 \item[literals or variables (mixed):]
 609 Presumably just a variant on the constructor case (as it is now).
 610 \end{description}
 611
 612 %************************************************************************
 613 %*                                                                      *
 614 %* match on an unmixed block: the real business                         *
 615 %*                                                                      *
 616 %************************************************************************
 617 \subsection[matchUnmixedEqns]{@matchUnmixedEqns@: getting down to business}
 618
 619 The function @matchUnmixedEqns@ is where the matching stuff sets to
 620 work a block of equations, to which the mixture rule has been applied.
 621 Its arguments and results are the same as for the ``top-level'' @match@.
 622
 623 \begin{code}
 624 matchUnmixedEqns :: [Id]
 625                   -> [EquationInfo]
 626                   -> DsM MatchResult
 627
 628 matchUnmixedEqns [] _ = panic "matchUnmixedEqns: no names"
 629
 630 matchUnmixedEqns all_vars@(var:vars) eqns_info
 631   | isWildPat first_pat
 632   = ASSERT( all isWildPat column_1_pats )       -- Sanity check
 633         -- Real true variables, just like in matchVar, SLPJ p 94
 634         -- No binding to do: they'll all be wildcards by now (done in tidy)
 635     match vars remaining_eqns_info
 636
 637   | isConPat first_pat
 638   = ASSERT( patsAreAllCons column_1_pats )
 639     matchConFamily all_vars eqns_info
 640
 641   | isLitPat first_pat
 642   = ASSERT( patsAreAllLits column_1_pats )
 643         -- see notes in MatchLiteral
 644         -- not worried about the same literal more than once in a column
 645         -- (ToDo: sort this out later)
 646     matchLiterals all_vars eqns_info
 647
 648   where
 649     first_pat           = head column_1_pats
 650     column_1_pats       = [pat                       | EqnInfo _ _ (pat:_)  _            <- eqns_info]
 651     remaining_eqns_info = [EqnInfo n ctx pats match_result | EqnInfo n ctx (_:pats) match_result <- eqns_info]
 652 \end{code}
 653
 654 %************************************************************************
 655 %*                                                                      *
 656 %*  matchWrapper: a convenient way to call @match@                      *
 657 %*                                                                      *
 658 %************************************************************************
 659 \subsection[matchWrapper]{@matchWrapper@: a convenient interface to @match@}
 660
 661 Calls to @match@ often involve similar (non-trivial) work; that work
 662 is collected here, in @matchWrapper@.  This function takes as
 663 arguments:
 664 \begin{itemize}
 665 \item
 666 Typchecked @Matches@ (of a function definition, or a case or lambda
 667 expression)---the main input;
 668 \item
 669 An error message to be inserted into any (runtime) pattern-matching
 670 failure messages.
 671 \end{itemize}
 672
 673 As results, @matchWrapper@ produces:
 674 \begin{itemize}
 675 \item
 676 A list of variables (@Locals@) that the caller must ``promise'' to
 677 bind to appropriate values; and
 678 \item
 679 a @CoreExpr@, the desugared output (main result).
 680 \end{itemize}
 681
 682 The main actions of @matchWrapper@ include:
 683 \begin{enumerate}
 684 \item
 685 Flatten the @[TypecheckedMatch]@ into a suitable list of
 686 @EquationInfo@s.
 687 \item
 688 Create as many new variables as there are patterns in a pattern-list
 689 (in any one of the @EquationInfo@s).
 690 \item
 691 Create a suitable ``if it fails'' expression---a call to @error@ using
 692 the error-string input; the {\em type} of this fail value can be found
 693 by examining one of the RHS expressions in one of the @EquationInfo@s.
 694 \item
 695 Call @match@ with all of this information!
 696 \end{enumerate}
 697
 698 \begin{code}
 699 matchWrapper :: DsMatchKind                     -- For shadowing warning messages
 700              -> [TypecheckedMatch]              -- Matches being desugared
 701              -> String                          -- Error message if the match fails
 702              -> DsM ([Id], CoreExpr)    -- Results
 703 \end{code}
 704
 705  There is one small problem with the Lambda Patterns, when somebody
 706  writes something similar to:
 707 \begin{verbatim}
 708     (\ (x:xs) -> ...)
 709 \end{verbatim}
 710  he/she don't want a warning about incomplete patterns, that is done with
 711  the flag @opt_WarnSimplePatterns@.
 712  This problem also appears in the:
 713 \begin{itemize}
 714 \item @do@ patterns, but if the @do@ can fail
 715       it creates another equation if the match can fail
 716       (see @DsExpr.doDo@ function)
 717 \item @let@ patterns, are treated by @matchSimply@
 718    List Comprension Patterns, are treated by @matchSimply@ also
 719 \end{itemize}
 720
 721 We can't call @matchSimply@ with Lambda patterns,
 722 due to the fact that lambda patterns can have more than
 723 one pattern, and match simply only accepts one pattern.
 724
 725 JJQC 30-Nov-1997
 726
 727 \begin{code}
 728 matchWrapper kind matches error_string
 729   = flattenMatches kind matches                 `thenDs` \ (result_ty, eqns_info) ->
 730     let
 731         EqnInfo _ _ arg_pats _ : _ = eqns_info
 732     in
 733     mapDs selectMatchVar arg_pats                       `thenDs` \ new_vars ->
 734     match_fun new_vars eqns_info                        `thenDs` \ match_result ->
 735
 736     mkErrorAppDs pAT_ERROR_ID result_ty error_string    `thenDs` \ fail_expr ->
 737     extractMatchResult match_result fail_expr           `thenDs` \ result_expr ->
 738     returnDs (new_vars, result_expr)
 739   where match_fun = case kind of
 740                       LambdaMatch | opt_WarnSimplePatterns -> matchExport
 741                                   | otherwise              -> match
 742                       _                                    -> matchExport
 743 \end{code}
 744
 745 %************************************************************************
 746 %*                                                                      *
 747 \subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern}
 748 %*                                                                      *
 749 %************************************************************************
 750
 751 @mkSimpleMatch@ is a wrapper for @match@ which deals with the
 752 situation where we want to match a single expression against a single
 753 pattern. It returns an expression.
 754
 755 \begin{code}
 756 matchSimply :: CoreExpr                 -- Scrutinee
 757             -> DsMatchKind              -- Match kind
 758             -> TypecheckedPat           -- Pattern it should match
 759             -> CoreExpr                 -- Return this if it matches
 760             -> CoreExpr                 -- Return this if it doesn't
 761             -> DsM CoreExpr
 762
 763 matchSimply scrut kind pat result_expr fail_expr
 764   = getSrcLocDs                                 `thenDs` \ locn ->
 765     let
 766       ctx          = DsMatchContext kind [pat] locn
 767       match_result = cantFailMatchResult result_expr
 768     in
 769     matchSinglePat scrut ctx pat match_result   `thenDs` \ match_result' ->
 770     extractMatchResult match_result' fail_expr
 771
 772
 773 matchSinglePat :: CoreExpr -> DsMatchContext -> TypecheckedPat
 774                -> MatchResult -> DsM MatchResult
 775
 776 matchSinglePat (Var var) ctx pat match_result
 777   = match_fn [var] [EqnInfo 1 ctx [pat] match_result]
 778   where
 779     match_fn | opt_WarnSimplePatterns = matchExport
 780              | otherwise              = match
 781
 782 matchSinglePat scrut ctx pat match_result
 783   = selectMatchVar pat                                  `thenDs` \ var ->
 784     matchSinglePat (Var var) ctx pat match_result       `thenDs` \ match_result' ->
 785     returnDs (adjustMatchResult (bindNonRec var scrut) match_result')
 786 \end{code}
 787
 788 %************************************************************************
 789 %*                                                                      *
 790 %*  flattenMatches : create a list of EquationInfo                      *
 791 %*                                                                      *
 792 %************************************************************************
 793
 794 \subsection[flattenMatches]{@flattenMatches@: create @[EquationInfo]@}
 795
 796 This is actually local to @matchWrapper@.
 797
 798 \begin{code}
 799 flattenMatches
 800         :: DsMatchKind
 801         -> [TypecheckedMatch]
 802         -> DsM (Type, [EquationInfo])
 803
 804 flattenMatches kind matches
 805   = mapAndUnzipDs flatten_match (matches `zip` [1..])   `thenDs` \ (result_tys, eqn_infos) ->
 806     let
 807         result_ty = head result_tys
 808     in
 809     ASSERT( all (== result_ty) result_tys )
 810     returnDs (result_ty, eqn_infos)
 811   where
 812     flatten_match (Match _ pats _ grhss, n)
 813       = dsGRHSs kind pats grhss                 `thenDs` \ (ty, match_result) ->
 814         getSrcLocDs                             `thenDs` \ locn ->
 815         returnDs (ty, EqnInfo n (DsMatchContext kind pats locn) pats match_result)
 816 \end{code}