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