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