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          ( hsPatType )
  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       ( consDataCon, mkTupleTy, mkListTy,
  28                           tupleCon, parrFakeCon, mkPArrTy )
  29 import BasicTypes       ( Boxity(..) )
  30 import UniqSet
  31 import SrcLoc           ( noSrcSpan, noLoc, unLoc, Located(..) )
  32 import Util             ( lengthExceeds, isSingleton, notNull )
  33 import Name             ( Name )
  34 import Outputable
  35 \end{code}
  36
  37 This function is a wrapper of @match@, it must be called from all the parts where
  38 it was called match, but only substitutes the firs call, ....
  39 if the associated flags are declared, warnings will be issued.
  40 It can not be called matchWrapper because this name already exists :-(
  41
  42 JJCQ 30-Nov-1997
  43
  44 \begin{code}
  45 matchExport :: [Id]             -- Vars rep'ing the exprs we're matching with
  46             -> [EquationInfo]   -- Info about patterns, etc. (type synonym below)
  47             -> DsM MatchResult  -- Desugared result!
  48
  49
  50 matchExport vars qs
  51    = getDOptsDs                                 `thenDs` \ dflags ->
  52      matchExport_really dflags vars qs
  53
  54 matchExport_really dflags vars qs@((EqnInfo _ ctx _ (MatchResult _ _)) : _)
  55   | incomplete && shadow =
  56       dsShadowWarn ctx eqns_shadow              `thenDs`   \ () ->
  57       dsIncompleteWarn ctx pats                 `thenDs`   \ () ->
  58       match vars qs
  59   | incomplete            =
  60       dsIncompleteWarn ctx pats                 `thenDs`   \ () ->
  61       match vars qs
  62   | shadow                =
  63       dsShadowWarn ctx eqns_shadow              `thenDs`   \ () ->
  64       match vars qs
  65   | otherwise             =
  66       match vars qs
  67   where (pats,indexs) = check qs
  68         incomplete    = dopt Opt_WarnIncompletePatterns dflags
  69                         && (notNull pats)
  70         shadow        = dopt Opt_WarnOverlappingPatterns dflags
  71                         && sizeUniqSet indexs < no_eqns
  72         no_eqns       = length qs
  73         unused_eqns   = uniqSetToList (mkUniqSet [1..no_eqns] `minusUniqSet` indexs)
  74         eqns_shadow   = map (\n -> qs!!(n - 1)) unused_eqns
  75 \end{code}
  76
  77 This variable shows the maximum number of lines of output generated for warnings.
  78 It will limit the number of patterns/equations displayed to@ maximum_output@.
  79
  80 (ToDo: add command-line option?)
  81
  82 \begin{code}
  83 maximum_output = 4
  84 \end{code}
  85
  86 The next two functions create the warning message.
  87
  88 \begin{code}
  89 dsShadowWarn :: DsMatchContext -> [EquationInfo] -> DsM ()
  90 dsShadowWarn ctx@(DsMatchContext kind _ _) qs = dsWarn warn
  91         where
  92           warn | qs `lengthExceeds` maximum_output
  93                = pp_context ctx (ptext SLIT("are overlapped"))
  94                             (\ f -> vcat (map (ppr_eqn f kind) (take maximum_output qs)) $$
  95                             ptext SLIT("..."))
  96                | otherwise
  97                = pp_context ctx (ptext SLIT("are overlapped"))
  98                             (\ f -> vcat $ map (ppr_eqn f kind) qs)
  99
 100
 101 dsIncompleteWarn :: DsMatchContext -> [ExhaustivePat] -> DsM ()
 102 dsIncompleteWarn ctx@(DsMatchContext kind _ _) pats = dsWarn warn
 103         where
 104           warn = pp_context ctx (ptext SLIT("are non-exhaustive"))
 105                             (\f -> hang (ptext SLIT("Patterns not matched:"))
 106                                    4 ((vcat $ map (ppr_incomplete_pats kind)
 107                                                   (take maximum_output pats))
 108                                       $$ dots))
 109
 110           dots | pats `lengthExceeds` maximum_output = ptext SLIT("...")
 111                | otherwise                           = empty
 112
 113 pp_context NoMatchContext msg rest_of_msg_fun
 114   = (noSrcSpan, ptext SLIT("Some match(es)") <+> hang msg 8 (rest_of_msg_fun id))
 115
 116 pp_context (DsMatchContext kind pats loc) msg rest_of_msg_fun
 117   = (loc, vcat [ptext SLIT("Pattern match(es)") <+> msg,
 118                 sep [ptext SLIT("In") <+> 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, \ 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 @matchEqnBlock@ 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   = mappM (tidyEqnInfo v) eqns_info     `thenDs` \ tidy_eqns_info ->
 271     let
 272         tidy_eqns_blks = unmix_eqns tidy_eqns_info
 273     in
 274     mappM (matchEqnBlock vars) tidy_eqns_blks   `thenDs` \ match_results ->
 275     returnDs (foldr1 combineMatchResults match_results)
 276   where
 277     unmix_eqns []    = []
 278     unmix_eqns [eqn] = [ [eqn] ]
 279     unmix_eqns (eq1@(EqnInfo _ _ (p1:p1s) _) : eq2@(EqnInfo _ _ (p2:p2s) _) : eqs)
 280       = if (  (isWildPat p1 && isWildPat p2)
 281            || (isConPat  p1 && isConPat  p2)
 282            || (isLitPat  p1 && isLitPat  p2) ) then
 283             eq1 `tack_onto` unmixed_rest
 284         else
 285             [ eq1 ] : unmixed_rest
 286       where
 287         unmixed_rest = unmix_eqns (eq2:eqs)
 288
 289         x `tack_onto` xss   = ( x : head xss) : tail xss
 290 \end{code}
 291
 292 Tidy up the leftmost pattern in an @EquationInfo@, given the variable @v@
 293 which will be scrutinised.  This means:
 294 \begin{itemize}
 295 \item
 296 Replace variable patterns @x@ (@x /= v@) with the pattern @_@,
 297 together with the binding @x = v@.
 298 \item
 299 Replace the `as' pattern @x@@p@ with the pattern p and a binding @x = v@.
 300 \item
 301 Removing lazy (irrefutable) patterns (you don't want to know...).
 302 \item
 303 Converting explicit tuple-, list-, and parallel-array-pats into ordinary
 304 @ConPats@.
 305 \item
 306 Convert the literal pat "" to [].
 307 \end{itemize}
 308
 309 The result of this tidying is that the column of patterns will include
 310 {\em only}:
 311 \begin{description}
 312 \item[@WildPats@:]
 313 The @VarPat@ information isn't needed any more after this.
 314
 315 \item[@ConPats@:]
 316 @ListPats@, @TuplePats@, etc., are all converted into @ConPats@.
 317
 318 \item[@LitPats@ and @NPats@:]
 319 @LitPats@/@NPats@ of ``known friendly types'' (Int, Char,
 320 Float,  Double, at least) are converted to unboxed form; e.g.,
 321 \tr{(NPat (HsInt i) _ _)} is converted to:
 322 \begin{verbatim}
 323 (ConPat I# _ _ [LitPat (HsIntPrim i)])
 324 \end{verbatim}
 325 \end{description}
 326
 327 \begin{code}
 328 tidyEqnInfo :: Id -> EquationInfo -> DsM EquationInfo
 329         -- DsM'd because of internal call to "match".
 330         -- "tidy1" does the interesting stuff, looking at
 331         -- one pattern and fiddling the list of bindings.
 332         --
 333         -- POST CONDITION: head pattern in the EqnInfo is
 334         --      WildPat
 335         --      ConPat
 336         --      NPat
 337         --      LitPat
 338         --      NPlusKPat
 339         --      SigPat
 340         -- but no other
 341
 342 tidyEqnInfo v (EqnInfo n ctx (pat : pats) match_result)
 343   = tidy1 v pat match_result    `thenDs` \ (pat', match_result') ->
 344     returnDs (EqnInfo n ctx (pat' : pats) match_result')
 345
 346
 347 tidy1 :: Id                     -- The Id being scrutinised
 348       -> Pat Id                 -- The pattern against which it is to be matched
 349       -> MatchResult            -- Current thing do do after matching
 350       -> DsM (Pat Id,           -- Equivalent pattern
 351               MatchResult)      -- Augmented thing to do afterwards
 352                                 -- The augmentation usually takes the form
 353                                 -- of new bindings to be added to the front
 354
 355 -------------------------------------------------------
 356 --      (pat', mr') = tidy1 v pat mr
 357 -- tidies the *outer level only* of pat, giving pat'
 358 -- It eliminates many pattern forms (as-patterns, variable patterns,
 359 -- list patterns, etc) yielding one of:
 360 --      WildPat
 361 --      ConPat
 362 --      LitPat
 363 --      NPat
 364 --      NPlusKPat
 365 --
 366
 367 tidy1 v (ParPat pat) match_result
 368   = tidy1 v (unLoc pat) match_result
 369
 370         -- case v of { x -> mr[] }
 371         -- = case v of { _ -> let x=v in mr[] }
 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         -- case v of { x@p -> mr[] }
 379         -- = case v of { p -> let x=v in mr[] }
 380 tidy1 v (AsPat (L _ var) pat) match_result
 381   = tidy1 v (unLoc pat) match_result'
 382   where
 383     match_result' | v == var  = match_result
 384                   | otherwise = adjustMatchResult (bindNonRec var (Var v)) match_result
 385
 386 tidy1 v (WildPat ty) match_result
 387   = returnDs (WildPat ty, match_result)
 388
 389 {- now, here we handle lazy patterns:
 390     tidy1 v ~p bs = (v, v1 = case v of p -> v1 :
 391                         v2 = case v of p -> v2 : ... : bs )
 392
 393     where the v_i's are the binders in the pattern.
 394
 395     ToDo: in "v_i = ... -> v_i", are the v_i's really the same thing?
 396
 397     The case expr for v_i is just: match [v] [(p, [], \ x -> Var v_i)] any_expr
 398 -}
 399
 400 tidy1 v (LazyPat pat) match_result
 401   = mkSelectorBinds pat (Var v)         `thenDs` \ sel_binds ->
 402     returnDs (WildPat (idType v),
 403               mkCoLetsMatchResult [NonRec b rhs | (b,rhs) <- sel_binds] match_result)
 404
 405 -- re-express <con-something> as (ConPat ...) [directly]
 406
 407 tidy1 v (ConPatOut con ps pat_ty ex_tvs dicts) match_result
 408   = returnDs (ConPatOut con tidy_ps pat_ty ex_tvs dicts, match_result)
 409   where
 410     tidy_ps = PrefixCon (tidy_con con pat_ty ex_tvs ps)
 411
 412 tidy1 v (ListPat pats ty) match_result
 413   = returnDs (unLoc list_ConPat, match_result)
 414   where
 415     list_ty     = mkListTy ty
 416     list_ConPat = foldr (\ x y -> mkPrefixConPat consDataCon [x, y] list_ty)
 417                         (mkNilPat list_ty)
 418                         pats
 419
 420 -- introduce fake parallel array constructors to be able to handle parallel
 421 -- arrays with the existing machinery for constructor pattern
 422 --
 423 tidy1 v (PArrPat pats ty) match_result
 424   = returnDs (unLoc parrConPat, match_result)
 425   where
 426     arity      = length pats
 427     parrConPat = mkPrefixConPat (parrFakeCon arity) pats (mkPArrTy ty)
 428
 429 tidy1 v (TuplePat pats boxity) match_result
 430   = returnDs (unLoc tuple_ConPat, match_result)
 431   where
 432     arity = length pats
 433     tuple_ConPat = mkPrefixConPat (tupleCon boxity arity) pats
 434                                   (mkTupleTy boxity arity (map hsPatType pats))
 435
 436 tidy1 v (DictPat dicts methods) match_result
 437   = case num_of_d_and_ms of
 438         0 -> tidy1 v (TuplePat [] Boxed) match_result
 439         1 -> tidy1 v (unLoc (head dict_and_method_pats)) match_result
 440         _ -> tidy1 v (TuplePat dict_and_method_pats Boxed) match_result
 441   where
 442     num_of_d_and_ms      = length dicts + length methods
 443     dict_and_method_pats = map nlVarPat (dicts ++ methods)
 444
 445 -- LitPats: we *might* be able to replace these w/ a simpler form
 446 tidy1 v pat@(LitPat lit) match_result
 447   = returnDs (unLoc (tidyLitPat lit (noLoc pat)), match_result)
 448
 449 -- NPats: we *might* be able to replace these w/ a simpler form
 450 tidy1 v pat@(NPatOut lit lit_ty _) match_result
 451   = returnDs (unLoc (tidyNPat lit lit_ty (noLoc pat)), match_result)
 452
 453 -- and everything else goes through unchanged...
 454
 455 tidy1 v non_interesting_pat match_result
 456   = returnDs (non_interesting_pat, match_result)
 457
 458
 459 tidy_con data_con pat_ty ex_tvs (PrefixCon ps)   = ps
 460 tidy_con data_con pat_ty ex_tvs (InfixCon p1 p2) = [p1,p2]
 461 tidy_con data_con pat_ty ex_tvs (RecCon rpats)
 462   | null rpats
 463   =     -- Special case for C {}, which can be used for
 464         -- a constructor that isn't declared to have
 465         -- fields at all
 466     map (noLoc.WildPat) con_arg_tys'
 467
 468   | otherwise
 469   = map mk_pat tagged_arg_tys
 470   where
 471         -- Boring stuff to find the arg-tys of the constructor
 472     inst_tys         = tcTyConAppArgs pat_ty    -- Newtypes must be opaque
 473     con_arg_tys'     = dataConInstOrigArgTys data_con (inst_tys ++ mkTyVarTys ex_tvs)
 474     tagged_arg_tys   = con_arg_tys' `zip` (dataConFieldLabels data_con)
 475
 476         -- mk_pat picks a WildPat of the appropriate type for absent fields,
 477         -- and the specified pattern for present fields
 478     mk_pat (arg_ty, lbl) =
 479         case [ pat | (sel_id,pat) <- rpats,
 480                      recordSelectorFieldLabel (unLoc sel_id) == lbl
 481              ] of
 482           (pat:pats) -> ASSERT( null pats )
 483                         pat
 484           []         -> noLoc (WildPat arg_ty)
 485 \end{code}
 486
 487 \noindent
 488 {\bf Previous @matchTwiddled@ stuff:}
 489
 490 Now we get to the only interesting part; note: there are choices for
 491 translation [from Simon's notes]; translation~1:
 492 \begin{verbatim}
 493 deTwiddle [s,t] e
 494 \end{verbatim}
 495 returns
 496 \begin{verbatim}
 497 [ w = e,
 498   s = case w of [s,t] -> s
 499   t = case w of [s,t] -> t
 500 ]
 501 \end{verbatim}
 502
 503 Here \tr{w} is a fresh variable, and the \tr{w}-binding prevents multiple
 504 evaluation of \tr{e}.  An alternative translation (No.~2):
 505 \begin{verbatim}
 506 [ w = case e of [s,t] -> (s,t)
 507   s = case w of (s,t) -> s
 508   t = case w of (s,t) -> t
 509 ]
 510 \end{verbatim}
 511
 512 %************************************************************************
 513 %*                                                                      *
 514 \subsubsection[improved-unmixing]{UNIMPLEMENTED idea for improved unmixing}
 515 %*                                                                      *
 516 %************************************************************************
 517
 518 We might be able to optimise unmixing when confronted by
 519 only-one-constructor-possible, of which tuples are the most notable
 520 examples.  Consider:
 521 \begin{verbatim}
 522 f (a,b,c) ... = ...
 523 f d ... (e:f) = ...
 524 f (g,h,i) ... = ...
 525 f j ...       = ...
 526 \end{verbatim}
 527 This definition would normally be unmixed into four equation blocks,
 528 one per equation.  But it could be unmixed into just one equation
 529 block, because if the one equation matches (on the first column),
 530 the others certainly will.
 531
 532 You have to be careful, though; the example
 533 \begin{verbatim}
 534 f j ...       = ...
 535 -------------------
 536 f (a,b,c) ... = ...
 537 f d ... (e:f) = ...
 538 f (g,h,i) ... = ...
 539 \end{verbatim}
 540 {\em must} be broken into two blocks at the line shown; otherwise, you
 541 are forcing unnecessary evaluation.  In any case, the top-left pattern
 542 always gives the cue.  You could then unmix blocks into groups of...
 543 \begin{description}
 544 \item[all variables:]
 545 As it is now.
 546 \item[constructors or variables (mixed):]
 547 Need to make sure the right names get bound for the variable patterns.
 548 \item[literals or variables (mixed):]
 549 Presumably just a variant on the constructor case (as it is now).
 550 \end{description}
 551
 552 %************************************************************************
 553 %*                                                                      *
 554 %* match on an unmixed block: the real business                         *
 555 %*                                                                      *
 556 %************************************************************************
 557 \subsection[matchEqnBlock]{@matchEqnBlock@: getting down to business}
 558
 559 The function @matchEqnBlock@ is where the matching stuff sets to
 560 work a block of equations, to which the mixture rule has been applied.
 561 Its arguments and results are the same as for the ``top-level'' @match@.
 562
 563 \begin{code}
 564 matchEqnBlock :: [Id]
 565               -> [EquationInfo]
 566               -> DsM MatchResult
 567
 568 matchEqnBlock [] _ = panic "matchEqnBlock: no names"
 569
 570 matchEqnBlock all_vars@(var:vars) eqns_info
 571   | isWildPat first_pat
 572   = ASSERT( all isWildPat column_1_pats )       -- Sanity check
 573         -- Real true variables, just like in matchVar, SLPJ p 94
 574         -- No binding to do: they'll all be wildcards by now (done in tidy)
 575     match vars remaining_eqns_info
 576
 577   | isConPat first_pat
 578   = ASSERT( patsAreAllCons column_1_pats )
 579     matchConFamily all_vars eqns_info
 580
 581   | isLitPat first_pat
 582   = ASSERT( patsAreAllLits column_1_pats )
 583         -- see notes in MatchLiteral
 584         -- not worried about the same literal more than once in a column
 585         -- (ToDo: sort this out later)
 586     matchLiterals all_vars eqns_info
 587
 588   | isSigPat first_pat
 589   = ASSERT( isSingleton eqns_info )
 590     matchSigPat all_vars (head eqns_info)
 591   where
 592     first_pat           = head column_1_pats
 593     column_1_pats       = [pat                             | EqnInfo _ _   (pat:_)  _            <- eqns_info]
 594     remaining_eqns_info = [EqnInfo n ctx pats match_result | EqnInfo n ctx (_:pats) match_result <- eqns_info]
 595 \end{code}
 596
 597 A SigPat is a type coercion and must be handled one at at time.  We can't
 598 combine them unless the type of the pattern inside is identical, and we don't
 599 bother to check for that.  For example:
 600
 601         data T = T1 Int | T2 Bool
 602         f :: (forall a. a -> a) -> T -> t
 603         f (g::Int->Int)   (T1 i) = T1 (g i)
 604         f (g::Bool->Bool) (T2 b) = T2 (g b)
 605
 606 We desugar this as follows:
 607
 608         f = \ g::(forall a. a->a) t::T ->
 609             let gi = g Int
 610             in case t of { T1 i -> T1 (gi i)
 611                            other ->
 612             let gb = g Bool
 613             in case t of { T2 b -> T2 (gb b)
 614                            other -> fail }}
 615
 616 Note that we do not treat the first column of patterns as a
 617 column of variables, because the coerced variables (gi, gb)
 618 would be of different types.  So we get rather grotty code.
 619 But I don't think this is a common case, and if it was we could
 620 doubtless improve it.
 621
 622 Meanwhile, the strategy is:
 623         * treat each SigPat coercion (always non-identity coercions)
 624                 as a separate block
 625         * deal with the stuff inside, and then wrap a binding round
 626                 the result to bind the new variable (gi, gb, etc)
 627
 628 \begin{code}
 629 matchSigPat :: [Id] -> EquationInfo -> DsM MatchResult
 630 matchSigPat (var:vars) (EqnInfo n ctx (SigPatOut pat ty co_fn : pats) result)
 631   = selectMatchVarL pat                                         `thenDs` \ new_var ->
 632     dsExpr (HsApp (noLoc co_fn) (nlHsVar var))          `thenDs` \ rhs ->
 633     match (new_var:vars) [EqnInfo n ctx (unLoc pat:pats) result] `thenDs` \ result' ->
 634     returnDs (adjustMatchResult (bindNonRec new_var rhs) result')
 635 \end{code}
 636
 637 %************************************************************************
 638 %*                                                                      *
 639 %*  matchWrapper: a convenient way to call @match@                      *
 640 %*                                                                      *
 641 %************************************************************************
 642 \subsection[matchWrapper]{@matchWrapper@: a convenient interface to @match@}
 643
 644 Calls to @match@ often involve similar (non-trivial) work; that work
 645 is collected here, in @matchWrapper@.  This function takes as
 646 arguments:
 647 \begin{itemize}
 648 \item
 649 Typchecked @Matches@ (of a function definition, or a case or lambda
 650 expression)---the main input;
 651 \item
 652 An error message to be inserted into any (runtime) pattern-matching
 653 failure messages.
 654 \end{itemize}
 655
 656 As results, @matchWrapper@ produces:
 657 \begin{itemize}
 658 \item
 659 A list of variables (@Locals@) that the caller must ``promise'' to
 660 bind to appropriate values; and
 661 \item
 662 a @CoreExpr@, the desugared output (main result).
 663 \end{itemize}
 664
 665 The main actions of @matchWrapper@ include:
 666 \begin{enumerate}
 667 \item
 668 Flatten the @[TypecheckedMatch]@ into a suitable list of
 669 @EquationInfo@s.
 670 \item
 671 Create as many new variables as there are patterns in a pattern-list
 672 (in any one of the @EquationInfo@s).
 673 \item
 674 Create a suitable ``if it fails'' expression---a call to @error@ using
 675 the error-string input; the {\em type} of this fail value can be found
 676 by examining one of the RHS expressions in one of the @EquationInfo@s.
 677 \item
 678 Call @match@ with all of this information!
 679 \end{enumerate}
 680
 681 \begin{code}
 682 matchWrapper :: HsMatchContext Name     -- For shadowing warning messages
 683              -> [LMatch Id]             -- Matches being desugared
 684              -> DsM ([Id], CoreExpr)    -- Results
 685 \end{code}
 686
 687  There is one small problem with the Lambda Patterns, when somebody
 688  writes something similar to:
 689 \begin{verbatim}
 690     (\ (x:xs) -> ...)
 691 \end{verbatim}
 692  he/she don't want a warning about incomplete patterns, that is done with
 693  the flag @opt_WarnSimplePatterns@.
 694  This problem also appears in the:
 695 \begin{itemize}
 696 \item @do@ patterns, but if the @do@ can fail
 697       it creates another equation if the match can fail
 698       (see @DsExpr.doDo@ function)
 699 \item @let@ patterns, are treated by @matchSimply@
 700    List Comprension Patterns, are treated by @matchSimply@ also
 701 \end{itemize}
 702
 703 We can't call @matchSimply@ with Lambda patterns,
 704 due to the fact that lambda patterns can have more than
 705 one pattern, and match simply only accepts one pattern.
 706
 707 JJQC 30-Nov-1997
 708
 709 \begin{code}
 710 matchWrapper ctxt matches
 711   = getDOptsDs                                  `thenDs` \ dflags ->
 712     flattenMatches ctxt matches                 `thenDs` \ (result_ty, eqns_info) ->
 713     let
 714         EqnInfo _ _ arg_pats _ : _ = eqns_info
 715         error_string = matchContextErrString ctxt
 716     in
 717     mappM selectMatchVar arg_pats               `thenDs` \ new_vars ->
 718     match_fun dflags new_vars eqns_info         `thenDs` \ match_result ->
 719
 720     mkErrorAppDs pAT_ERROR_ID result_ty error_string    `thenDs` \ fail_expr ->
 721     extractMatchResult match_result fail_expr           `thenDs` \ result_expr ->
 722     returnDs (new_vars, result_expr)
 723   where match_fun dflags
 724            = case ctxt of
 725                 LambdaExpr | dopt Opt_WarnSimplePatterns dflags -> matchExport
 726                            | otherwise                          -> match
 727                 _                                               -> matchExport
 728 \end{code}
 729
 730 %************************************************************************
 731 %*                                                                      *
 732 \subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern}
 733 %*                                                                      *
 734 %************************************************************************
 735
 736 @mkSimpleMatch@ is a wrapper for @match@ which deals with the
 737 situation where we want to match a single expression against a single
 738 pattern. It returns an expression.
 739
 740 \begin{code}
 741 matchSimply :: CoreExpr                 -- Scrutinee
 742             -> HsMatchContext Name      -- Match kind
 743             -> LPat Id                  -- Pattern it should match
 744             -> CoreExpr                 -- Return this if it matches
 745             -> CoreExpr                 -- Return this if it doesn't
 746             -> DsM CoreExpr
 747
 748 matchSimply scrut kind pat result_expr fail_expr
 749   = getSrcSpanDs                                `thenDs` \ locn ->
 750     let
 751       ctx          = DsMatchContext kind [unLoc pat] locn
 752       match_result = cantFailMatchResult result_expr
 753     in
 754     matchSinglePat scrut ctx pat match_result   `thenDs` \ match_result' ->
 755     extractMatchResult match_result' fail_expr
 756
 757
 758 matchSinglePat :: CoreExpr -> DsMatchContext -> LPat Id
 759                -> MatchResult -> DsM MatchResult
 760
 761 matchSinglePat (Var var) ctx pat match_result
 762   = getDOptsDs                                  `thenDs` \ dflags ->
 763     match_fn dflags [var] [EqnInfo 1 ctx [unLoc pat] match_result]
 764   where
 765     match_fn dflags
 766        | dopt Opt_WarnSimplePatterns dflags = matchExport
 767        | otherwise                          = match
 768
 769 matchSinglePat scrut ctx pat match_result
 770   = selectMatchVarL pat                                 `thenDs` \ var ->
 771     matchSinglePat (Var var) ctx pat match_result       `thenDs` \ match_result' ->
 772     returnDs (adjustMatchResult (bindNonRec var scrut) match_result')
 773 \end{code}
 774
 775 %************************************************************************
 776 %*                                                                      *
 777 %*  flattenMatches : create a list of EquationInfo                      *
 778 %*                                                                      *
 779 %************************************************************************
 780
 781 \subsection[flattenMatches]{@flattenMatches@: create @[EquationInfo]@}
 782
 783 This is actually local to @matchWrapper@.
 784
 785 \begin{code}
 786 flattenMatches :: HsMatchContext Name
 787                -> [LMatch Id]
 788                -> DsM (Type, [EquationInfo])
 789
 790 flattenMatches kind matches
 791   = mapAndUnzipDs flatten_match (matches `zip` [1..])   `thenDs` \ (result_tys, eqn_infos) ->
 792     let
 793         result_ty = head result_tys
 794     in
 795     ASSERT( all (tcEqType result_ty) result_tys )
 796     returnDs (result_ty, eqn_infos)
 797   where
 798     flatten_match (L _ (Match pats _ grhss), n)
 799       = dsGRHSs kind upats grhss        `thenDs` \ (ty, match_result) ->
 800         getSrcSpanDs                            `thenDs` \ locn ->
 801         returnDs (ty, EqnInfo n (DsMatchContext kind upats locn) upats match_result)
 802         where upats = map unLoc pats
 803 \end{code}