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