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