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