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