compiler/deSugar/Match.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5
   6 The @match@ function
   7
   8 \begin{code}
   9 module Match ( match, matchEquations, matchWrapper, matchSimply, matchSinglePat ) where
  10
  11 #include "HsVersions.h"
  12
  13 import DynFlags
  14 import HsSyn
  15 import TcHsSyn
  16 import Check
  17 import CoreSyn
  18 import Literal
  19 import CoreUtils
  20 import DsMonad
  21 import DsBinds
  22 import DsGRHSs
  23 import DsUtils
  24 import Id
  25 import DataCon
  26 import MatchCon
  27 import MatchLit
  28 import PrelInfo
  29 import TcType
  30 import Type
  31 import TysWiredIn
  32 import BasicTypes
  33 import ListSetOps
  34 import SrcLoc
  35 import Maybes
  36 import Util
  37 import Name
  38 import Outputable
  39 \end{code}
  40
  41 This function is a wrapper of @match@, it must be called from all the parts where
  42 it was called match, but only substitutes the firs call, ....
  43 if the associated flags are declared, warnings will be issued.
  44 It can not be called matchWrapper because this name already exists :-(
  45
  46 JJCQ 30-Nov-1997
  47
  48 \begin{code}
  49 matchCheck ::  DsMatchContext
  50             -> [Id]             -- Vars rep'ing the exprs we're matching with
  51             -> Type             -- Type of the case expression
  52             -> [EquationInfo]   -- Info about patterns, etc. (type synonym below)
  53             -> DsM MatchResult  -- Desugared result!
  54
  55 matchCheck ctx vars ty qs
  56    = getDOptsDs                                 `thenDs` \ dflags ->
  57      matchCheck_really dflags ctx vars ty qs
  58
  59 matchCheck_really dflags ctx vars ty qs
  60   | incomplete && shadow =
  61       dsShadowWarn ctx eqns_shadow              `thenDs`   \ () ->
  62       dsIncompleteWarn ctx pats                 `thenDs`   \ () ->
  63       match vars ty qs
  64   | incomplete            =
  65       dsIncompleteWarn ctx pats                 `thenDs`   \ () ->
  66       match vars ty qs
  67   | shadow                =
  68       dsShadowWarn ctx eqns_shadow              `thenDs`   \ () ->
  69       match vars ty qs
  70   | otherwise             =
  71       match vars ty qs
  72   where (pats, eqns_shadow) = check qs
  73         incomplete    = want_incomplete && (notNull pats)
  74         want_incomplete = case ctx of
  75                               DsMatchContext RecUpd _ ->
  76                                   dopt Opt_WarnIncompletePatternsRecUpd dflags
  77                               _ ->
  78                                   dopt Opt_WarnIncompletePatterns       dflags
  79         shadow        = dopt Opt_WarnOverlappingPatterns dflags
  80                         && not (null eqns_shadow)
  81 \end{code}
  82
  83 This variable shows the maximum number of lines of output generated for warnings.
  84 It will limit the number of patterns/equations displayed to@ maximum_output@.
  85
  86 (ToDo: add command-line option?)
  87
  88 \begin{code}
  89 maximum_output = 4
  90 \end{code}
  91
  92 The next two functions create the warning message.
  93
  94 \begin{code}
  95 dsShadowWarn :: DsMatchContext -> [EquationInfo] -> DsM ()
  96 dsShadowWarn ctx@(DsMatchContext kind loc) qs
  97   = putSrcSpanDs loc (warnDs warn)
  98   where
  99     warn | qs `lengthExceeds` maximum_output
 100          = pp_context ctx (ptext SLIT("are overlapped"))
 101                       (\ f -> vcat (map (ppr_eqn f kind) (take maximum_output qs)) $$
 102                       ptext SLIT("..."))
 103          | otherwise
 104          = pp_context ctx (ptext SLIT("are overlapped"))
 105                       (\ f -> vcat $ map (ppr_eqn f kind) qs)
 106
 107
 108 dsIncompleteWarn :: DsMatchContext -> [ExhaustivePat] -> DsM ()
 109 dsIncompleteWarn ctx@(DsMatchContext kind loc) pats
 110   = putSrcSpanDs loc (warnDs warn)
 111         where
 112           warn = pp_context ctx (ptext SLIT("are non-exhaustive"))
 113                             (\f -> hang (ptext SLIT("Patterns not matched:"))
 114                                    4 ((vcat $ map (ppr_incomplete_pats kind)
 115                                                   (take maximum_output pats))
 116                                       $$ dots))
 117
 118           dots | pats `lengthExceeds` maximum_output = ptext SLIT("...")
 119                | otherwise                           = empty
 120
 121 pp_context (DsMatchContext kind _loc) msg rest_of_msg_fun
 122   = vcat [ptext SLIT("Pattern match(es)") <+> msg,
 123           sep [ptext SLIT("In") <+> ppr_match <> char ':', nest 4 (rest_of_msg_fun pref)]]
 124   where
 125     (ppr_match, pref)
 126         = case kind of
 127              FunRhs fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp)
 128              other      -> (pprMatchContext kind, \ pp -> pp)
 129
 130 ppr_pats pats = sep (map ppr pats)
 131
 132 ppr_shadow_pats kind pats
 133   = sep [ppr_pats pats, matchSeparator kind, ptext SLIT("...")]
 134
 135 ppr_incomplete_pats kind (pats,[]) = ppr_pats pats
 136 ppr_incomplete_pats kind (pats,constraints) =
 137                          sep [ppr_pats pats, ptext SLIT("with"),
 138                               sep (map ppr_constraint constraints)]
 139
 140
 141 ppr_constraint (var,pats) = sep [ppr var, ptext SLIT("`notElem`"), ppr pats]
 142
 143 ppr_eqn prefixF kind eqn = prefixF (ppr_shadow_pats kind (eqn_pats eqn))
 144 \end{code}
 145
 146
 147 %************************************************************************
 148 %*                                                                      *
 149                 The main matching function
 150 %*                                                                      *
 151 %************************************************************************
 152
 153 The function @match@ is basically the same as in the Wadler chapter,
 154 except it is monadised, to carry around the name supply, info about
 155 annotations, etc.
 156
 157 Notes on @match@'s arguments, assuming $m$ equations and $n$ patterns:
 158 \begin{enumerate}
 159 \item
 160 A list of $n$ variable names, those variables presumably bound to the
 161 $n$ expressions being matched against the $n$ patterns.  Using the
 162 list of $n$ expressions as the first argument showed no benefit and
 163 some inelegance.
 164
 165 \item
 166 The second argument, a list giving the ``equation info'' for each of
 167 the $m$ equations:
 168 \begin{itemize}
 169 \item
 170 the $n$ patterns for that equation, and
 171 \item
 172 a list of Core bindings [@(Id, CoreExpr)@ pairs] to be ``stuck on
 173 the front'' of the matching code, as in:
 174 \begin{verbatim}
 175 let <binds>
 176 in  <matching-code>
 177 \end{verbatim}
 178 \item
 179 and finally: (ToDo: fill in)
 180
 181 The right way to think about the ``after-match function'' is that it
 182 is an embryonic @CoreExpr@ with a ``hole'' at the end for the
 183 final ``else expression''.
 184 \end{itemize}
 185
 186 There is a type synonym, @EquationInfo@, defined in module @DsUtils@.
 187
 188 An experiment with re-ordering this information about equations (in
 189 particular, having the patterns available in column-major order)
 190 showed no benefit.
 191
 192 \item
 193 A default expression---what to evaluate if the overall pattern-match
 194 fails.  This expression will (almost?) always be
 195 a measly expression @Var@, unless we know it will only be used once
 196 (as we do in @glue_success_exprs@).
 197
 198 Leaving out this third argument to @match@ (and slamming in lots of
 199 @Var "fail"@s) is a positively {\em bad} idea, because it makes it
 200 impossible to share the default expressions.  (Also, it stands no
 201 chance of working in our post-upheaval world of @Locals@.)
 202 \end{enumerate}
 203
 204 Note: @match@ is often called via @matchWrapper@ (end of this module),
 205 a function that does much of the house-keeping that goes with a call
 206 to @match@.
 207
 208 It is also worth mentioning the {\em typical} way a block of equations
 209 is desugared with @match@.  At each stage, it is the first column of
 210 patterns that is examined.  The steps carried out are roughly:
 211 \begin{enumerate}
 212 \item
 213 Tidy the patterns in column~1 with @tidyEqnInfo@ (this may add
 214 bindings to the second component of the equation-info):
 215 \begin{itemize}
 216 \item
 217 Remove the `as' patterns from column~1.
 218 \item
 219 Make all constructor patterns in column~1 into @ConPats@, notably
 220 @ListPats@ and @TuplePats@.
 221 \item
 222 Handle any irrefutable (or ``twiddle'') @LazyPats@.
 223 \end{itemize}
 224 \item
 225 Now {\em unmix} the equations into {\em blocks} [w/ local function
 226 @unmix_eqns@], in which the equations in a block all have variable
 227 patterns in column~1, or they all have constructor patterns in ...
 228 (see ``the mixture rule'' in SLPJ).
 229 \item
 230 Call @matchEqnBlock@ on each block of equations; it will do the
 231 appropriate thing for each kind of column-1 pattern, usually ending up
 232 in a recursive call to @match@.
 233 \end{enumerate}
 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 This (more interesting) clause of @match@ uses @tidy_and_unmix_eqns@
 240 (a)~to get `as'- and `twiddle'-patterns out of the way (tidying), and
 241 (b)~to do ``the mixture rule'' (SLPJ, p.~88) [which really {\em
 242 un}mixes the equations], producing a list of equation-info
 243 blocks, each block having as its first column of patterns either all
 244 constructors, or all variables (or similar beasts), etc.
 245
 246 @match_unmixed_eqn_blks@ simply takes the place of the @foldr@ in the
 247 Wadler-chapter @match@ (p.~93, last clause), and @match_unmixed_blk@
 248 corresponds roughly to @matchVarCon@.
 249
 250 \begin{code}
 251 match :: [Id]             -- Variables rep'ing the exprs we're matching with
 252       -> Type             -- Type of the case expression
 253       -> [EquationInfo]   -- Info about patterns, etc. (type synonym below)
 254       -> DsM MatchResult  -- Desugared result!
 255
 256 match [] ty eqns
 257   = ASSERT2( not (null eqns), ppr ty )
 258     returnDs (foldr1 combineMatchResults match_results)
 259   where
 260     match_results = [ ASSERT( null (eqn_pats eqn) )
 261                       eqn_rhs eqn
 262                     | eqn <- eqns ]
 263
 264 match vars@(v:_) ty eqns
 265   = ASSERT( not (null eqns ) )
 266     do  {       -- Tidy the first pattern, generating
 267                 -- auxiliary bindings if necessary
 268           (aux_binds, tidy_eqns) <- mapAndUnzipM (tidyEqnInfo v) eqns
 269
 270                 -- Group the equations and match each group in turn
 271         ; match_results <- mapM match_group (groupEquations tidy_eqns)
 272
 273         ; return (adjustMatchResult (foldr1 (.) aux_binds) $
 274                   foldr1 combineMatchResults match_results) }
 275   where
 276     dropGroup :: [(PatGroup,EquationInfo)] -> [EquationInfo]
 277     dropGroup = map snd
 278
 279     match_group :: [(PatGroup,EquationInfo)] -> DsM MatchResult
 280     match_group eqns@((group,_) : _)
 281       = case group of
 282           PgAny     -> matchVariables  vars ty (dropGroup eqns)
 283           PgCon _   -> matchConFamily  vars ty (subGroups eqns)
 284           PgLit _   -> matchLiterals   vars ty (subGroups eqns)
 285           PgN lit   -> matchNPats      vars ty (subGroups eqns)
 286           PgNpK lit -> matchNPlusKPats vars ty (dropGroup eqns)
 287           PgBang    -> matchBangs      vars ty (dropGroup eqns)
 288           PgCo _    -> matchCoercion   vars ty (dropGroup eqns)
 289
 290 matchVariables :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
 291 -- Real true variables, just like in matchVar, SLPJ p 94
 292 -- No binding to do: they'll all be wildcards by now (done in tidy)
 293 matchVariables (var:vars) ty eqns = match vars ty (shiftEqns eqns)
 294
 295 matchBangs :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
 296 matchBangs (var:vars) ty eqns
 297   = do  { match_result <- match (var:vars) ty (map shift eqns)
 298         ; return (mkEvalMatchResult var ty match_result) }
 299   where
 300     shift eqn@(EqnInfo { eqn_pats = BangPat pat : pats })
 301         = eqn { eqn_pats = unLoc pat : pats }
 302
 303 matchCoercion :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
 304 -- Apply the coercion to the match variable and then match that
 305 matchCoercion (var:vars) ty (eqn1:eqns)
 306   = do  { let CoPat co pat _ = firstPat eqn1
 307         ; var' <- newUniqueId (idName var) (hsPatType pat)
 308         ; match_result <- match (var':vars) ty (map shift (eqn1:eqns))
 309         ; rhs <- dsCoercion co (return (Var var))
 310         ; return (mkCoLetMatchResult (NonRec var' rhs) match_result) }
 311   where
 312     shift eqn@(EqnInfo { eqn_pats = CoPat _ pat _ : pats })
 313         = eqn { eqn_pats = pat : pats }
 314 \end{code}
 315
 316 %************************************************************************
 317 %*                                                                      *
 318                 Tidying patterns
 319 %*                                                                      *
 320 %************************************************************************
 321
 322 Tidy up the leftmost pattern in an @EquationInfo@, given the variable @v@
 323 which will be scrutinised.  This means:
 324 \begin{itemize}
 325 \item
 326 Replace variable patterns @x@ (@x /= v@) with the pattern @_@,
 327 together with the binding @x = v@.
 328 \item
 329 Replace the `as' pattern @x@@p@ with the pattern p and a binding @x = v@.
 330 \item
 331 Removing lazy (irrefutable) patterns (you don't want to know...).
 332 \item
 333 Converting explicit tuple-, list-, and parallel-array-pats into ordinary
 334 @ConPats@.
 335 \item
 336 Convert the literal pat "" to [].
 337 \end{itemize}
 338
 339 The result of this tidying is that the column of patterns will include
 340 {\em only}:
 341 \begin{description}
 342 \item[@WildPats@:]
 343 The @VarPat@ information isn't needed any more after this.
 344
 345 \item[@ConPats@:]
 346 @ListPats@, @TuplePats@, etc., are all converted into @ConPats@.
 347
 348 \item[@LitPats@ and @NPats@:]
 349 @LitPats@/@NPats@ of ``known friendly types'' (Int, Char,
 350 Float,  Double, at least) are converted to unboxed form; e.g.,
 351 \tr{(NPat (HsInt i) _ _)} is converted to:
 352 \begin{verbatim}
 353 (ConPat I# _ _ [LitPat (HsIntPrim i)])
 354 \end{verbatim}
 355 \end{description}
 356
 357 \begin{code}
 358 tidyEqnInfo :: Id -> EquationInfo
 359             -> DsM (DsWrapper, EquationInfo)
 360         -- DsM'd because of internal call to dsLHsBinds
 361         --      and mkSelectorBinds.
 362         -- "tidy1" does the interesting stuff, looking at
 363         -- one pattern and fiddling the list of bindings.
 364         --
 365         -- POST CONDITION: head pattern in the EqnInfo is
 366         --      WildPat
 367         --      ConPat
 368         --      NPat
 369         --      LitPat
 370         --      NPlusKPat
 371         -- but no other
 372
 373 tidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats })
 374   = tidy1 v pat         `thenDs` \ (wrap, pat') ->
 375     returnDs (wrap, eqn { eqn_pats = pat' : pats })
 376
 377 tidy1 :: Id                     -- The Id being scrutinised
 378       -> Pat Id                 -- The pattern against which it is to be matched
 379       -> DsM (DsWrapper,        -- Extra bindings to do before the match
 380               Pat Id)           -- Equivalent pattern
 381
 382 -------------------------------------------------------
 383 --      (pat', mr') = tidy1 v pat mr
 384 -- tidies the *outer level only* of pat, giving pat'
 385 -- It eliminates many pattern forms (as-patterns, variable patterns,
 386 -- list patterns, etc) yielding one of:
 387 --      WildPat
 388 --      ConPatOut
 389 --      LitPat
 390 --      NPat
 391 --      NPlusKPat
 392
 393 tidy1 v (ParPat pat)      = tidy1 v (unLoc pat)
 394 tidy1 v (SigPatOut pat _) = tidy1 v (unLoc pat)
 395 tidy1 v (WildPat ty)      = returnDs (idDsWrapper, WildPat ty)
 396
 397         -- case v of { x -> mr[] }
 398         -- = case v of { _ -> let x=v in mr[] }
 399 tidy1 v (VarPat var)
 400   = returnDs (wrapBind var v, WildPat (idType var))
 401
 402 tidy1 v (VarPatOut var binds)
 403   = do  { prs <- dsLHsBinds binds
 404         ; return (wrapBind var v . mkDsLet (Rec prs),
 405                   WildPat (idType var)) }
 406
 407         -- case v of { x@p -> mr[] }
 408         -- = case v of { p -> let x=v in mr[] }
 409 tidy1 v (AsPat (L _ var) pat)
 410   = do  { (wrap, pat') <- tidy1 v (unLoc pat)
 411         ; return (wrapBind var v . wrap, pat') }
 412
 413 {- now, here we handle lazy patterns:
 414     tidy1 v ~p bs = (v, v1 = case v of p -> v1 :
 415                         v2 = case v of p -> v2 : ... : bs )
 416
 417     where the v_i's are the binders in the pattern.
 418
 419     ToDo: in "v_i = ... -> v_i", are the v_i's really the same thing?
 420
 421     The case expr for v_i is just: match [v] [(p, [], \ x -> Var v_i)] any_expr
 422 -}
 423
 424 tidy1 v (LazyPat pat)
 425   = do  { sel_prs <- mkSelectorBinds pat (Var v)
 426         ; let sel_binds =  [NonRec b rhs | (b,rhs) <- sel_prs]
 427         ; returnDs (mkDsLets sel_binds, WildPat (idType v)) }
 428
 429 tidy1 v (ListPat pats ty)
 430   = returnDs (idDsWrapper, unLoc list_ConPat)
 431   where
 432     list_ty     = mkListTy ty
 433     list_ConPat = foldr (\ x y -> mkPrefixConPat consDataCon [x, y] list_ty)
 434                         (mkNilPat list_ty)
 435                         pats
 436
 437 -- Introduce fake parallel array constructors to be able to handle parallel
 438 -- arrays with the existing machinery for constructor pattern
 439 tidy1 v (PArrPat pats ty)
 440   = returnDs (idDsWrapper, unLoc parrConPat)
 441   where
 442     arity      = length pats
 443     parrConPat = mkPrefixConPat (parrFakeCon arity) pats (mkPArrTy ty)
 444
 445 tidy1 v (TuplePat pats boxity ty)
 446   = returnDs (idDsWrapper, unLoc tuple_ConPat)
 447   where
 448     arity = length pats
 449     tuple_ConPat = mkPrefixConPat (tupleCon boxity arity) pats ty
 450
 451 tidy1 v (DictPat dicts methods)
 452   = case num_of_d_and_ms of
 453         0 -> tidy1 v (TuplePat [] Boxed unitTy)
 454         1 -> tidy1 v (unLoc (head dict_and_method_pats))
 455         _ -> tidy1 v (mkVanillaTuplePat dict_and_method_pats Boxed)
 456   where
 457     num_of_d_and_ms      = length dicts + length methods
 458     dict_and_method_pats = map nlVarPat (dicts ++ methods)
 459
 460 -- LitPats: we *might* be able to replace these w/ a simpler form
 461 tidy1 v (LitPat lit)
 462   = returnDs (idDsWrapper, tidyLitPat lit)
 463
 464 -- NPats: we *might* be able to replace these w/ a simpler form
 465 tidy1 v (NPat lit mb_neg eq lit_ty)
 466   = returnDs (idDsWrapper, tidyNPat lit mb_neg eq lit_ty)
 467
 468 -- Everything else goes through unchanged...
 469
 470 tidy1 v non_interesting_pat
 471   = returnDs (idDsWrapper, non_interesting_pat)
 472 \end{code}
 473
 474 \noindent
 475 {\bf Previous @matchTwiddled@ stuff:}
 476
 477 Now we get to the only interesting part; note: there are choices for
 478 translation [from Simon's notes]; translation~1:
 479 \begin{verbatim}
 480 deTwiddle [s,t] e
 481 \end{verbatim}
 482 returns
 483 \begin{verbatim}
 484 [ w = e,
 485   s = case w of [s,t] -> s
 486   t = case w of [s,t] -> t
 487 ]
 488 \end{verbatim}
 489
 490 Here \tr{w} is a fresh variable, and the \tr{w}-binding prevents multiple
 491 evaluation of \tr{e}.  An alternative translation (No.~2):
 492 \begin{verbatim}
 493 [ w = case e of [s,t] -> (s,t)
 494   s = case w of (s,t) -> s
 495   t = case w of (s,t) -> t
 496 ]
 497 \end{verbatim}
 498
 499 %************************************************************************
 500 %*                                                                      *
 501 \subsubsection[improved-unmixing]{UNIMPLEMENTED idea for improved unmixing}
 502 %*                                                                      *
 503 %************************************************************************
 504
 505 We might be able to optimise unmixing when confronted by
 506 only-one-constructor-possible, of which tuples are the most notable
 507 examples.  Consider:
 508 \begin{verbatim}
 509 f (a,b,c) ... = ...
 510 f d ... (e:f) = ...
 511 f (g,h,i) ... = ...
 512 f j ...       = ...
 513 \end{verbatim}
 514 This definition would normally be unmixed into four equation blocks,
 515 one per equation.  But it could be unmixed into just one equation
 516 block, because if the one equation matches (on the first column),
 517 the others certainly will.
 518
 519 You have to be careful, though; the example
 520 \begin{verbatim}
 521 f j ...       = ...
 522 -------------------
 523 f (a,b,c) ... = ...
 524 f d ... (e:f) = ...
 525 f (g,h,i) ... = ...
 526 \end{verbatim}
 527 {\em must} be broken into two blocks at the line shown; otherwise, you
 528 are forcing unnecessary evaluation.  In any case, the top-left pattern
 529 always gives the cue.  You could then unmix blocks into groups of...
 530 \begin{description}
 531 \item[all variables:]
 532 As it is now.
 533 \item[constructors or variables (mixed):]
 534 Need to make sure the right names get bound for the variable patterns.
 535 \item[literals or variables (mixed):]
 536 Presumably just a variant on the constructor case (as it is now).
 537 \end{description}
 538
 539 %************************************************************************
 540 %*                                                                      *
 541 %*  matchWrapper: a convenient way to call @match@                      *
 542 %*                                                                      *
 543 %************************************************************************
 544 \subsection[matchWrapper]{@matchWrapper@: a convenient interface to @match@}
 545
 546 Calls to @match@ often involve similar (non-trivial) work; that work
 547 is collected here, in @matchWrapper@.  This function takes as
 548 arguments:
 549 \begin{itemize}
 550 \item
 551 Typchecked @Matches@ (of a function definition, or a case or lambda
 552 expression)---the main input;
 553 \item
 554 An error message to be inserted into any (runtime) pattern-matching
 555 failure messages.
 556 \end{itemize}
 557
 558 As results, @matchWrapper@ produces:
 559 \begin{itemize}
 560 \item
 561 A list of variables (@Locals@) that the caller must ``promise'' to
 562 bind to appropriate values; and
 563 \item
 564 a @CoreExpr@, the desugared output (main result).
 565 \end{itemize}
 566
 567 The main actions of @matchWrapper@ include:
 568 \begin{enumerate}
 569 \item
 570 Flatten the @[TypecheckedMatch]@ into a suitable list of
 571 @EquationInfo@s.
 572 \item
 573 Create as many new variables as there are patterns in a pattern-list
 574 (in any one of the @EquationInfo@s).
 575 \item
 576 Create a suitable ``if it fails'' expression---a call to @error@ using
 577 the error-string input; the {\em type} of this fail value can be found
 578 by examining one of the RHS expressions in one of the @EquationInfo@s.
 579 \item
 580 Call @match@ with all of this information!
 581 \end{enumerate}
 582
 583 \begin{code}
 584 matchWrapper :: HsMatchContext Name     -- For shadowing warning messages
 585              -> MatchGroup Id           -- Matches being desugared
 586              -> DsM ([Id], CoreExpr)    -- Results
 587 \end{code}
 588
 589  There is one small problem with the Lambda Patterns, when somebody
 590  writes something similar to:
 591 \begin{verbatim}
 592     (\ (x:xs) -> ...)
 593 \end{verbatim}
 594  he/she don't want a warning about incomplete patterns, that is done with
 595  the flag @opt_WarnSimplePatterns@.
 596  This problem also appears in the:
 597 \begin{itemize}
 598 \item @do@ patterns, but if the @do@ can fail
 599       it creates another equation if the match can fail
 600       (see @DsExpr.doDo@ function)
 601 \item @let@ patterns, are treated by @matchSimply@
 602    List Comprension Patterns, are treated by @matchSimply@ also
 603 \end{itemize}
 604
 605 We can't call @matchSimply@ with Lambda patterns,
 606 due to the fact that lambda patterns can have more than
 607 one pattern, and match simply only accepts one pattern.
 608
 609 JJQC 30-Nov-1997
 610
 611 \begin{code}
 612 matchWrapper ctxt (MatchGroup matches match_ty)
 613   = do  { eqns_info   <- mapM mk_eqn_info matches
 614         ; new_vars    <- selectMatchVars arg_pats
 615         ; result_expr <- matchEquations ctxt new_vars eqns_info rhs_ty
 616         ; return (new_vars, result_expr) }
 617   where
 618     arg_pats    = map unLoc (hsLMatchPats (head matches))
 619     n_pats      = length arg_pats
 620     (_, rhs_ty) = splitFunTysN n_pats match_ty
 621
 622     mk_eqn_info (L _ (Match pats _ grhss))
 623       = do { let upats = map unLoc pats
 624            ; match_result <- dsGRHSs ctxt upats grhss rhs_ty
 625            ; return (EqnInfo { eqn_pats = upats, eqn_rhs  = match_result}) }
 626
 627
 628 matchEquations  :: HsMatchContext Name
 629                 -> [Id] -> [EquationInfo] -> Type
 630                 -> DsM CoreExpr
 631 matchEquations ctxt vars eqns_info rhs_ty
 632   = do  { dflags <- getDOptsDs
 633         ; locn   <- getSrcSpanDs
 634         ; let   ds_ctxt      = DsMatchContext ctxt locn
 635                 error_string = matchContextErrString ctxt
 636
 637         ; match_result <- match_fun dflags ds_ctxt vars rhs_ty eqns_info
 638
 639         ; fail_expr <- mkErrorAppDs pAT_ERROR_ID rhs_ty error_string
 640         ; extractMatchResult match_result fail_expr }
 641   where
 642     match_fun dflags ds_ctxt
 643        = case ctxt of
 644            LambdaExpr | dopt Opt_WarnSimplePatterns dflags -> matchCheck ds_ctxt
 645                       | otherwise                          -> match
 646            _                                               -> matchCheck ds_ctxt
 647 \end{code}
 648
 649 %************************************************************************
 650 %*                                                                      *
 651 \subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern}
 652 %*                                                                      *
 653 %************************************************************************
 654
 655 @mkSimpleMatch@ is a wrapper for @match@ which deals with the
 656 situation where we want to match a single expression against a single
 657 pattern. It returns an expression.
 658
 659 \begin{code}
 660 matchSimply :: CoreExpr                 -- Scrutinee
 661             -> HsMatchContext Name      -- Match kind
 662             -> LPat Id                  -- Pattern it should match
 663             -> CoreExpr                 -- Return this if it matches
 664             -> CoreExpr                 -- Return this if it doesn't
 665             -> DsM CoreExpr
 666
 667 matchSimply scrut hs_ctx pat result_expr fail_expr
 668   = let
 669       match_result = cantFailMatchResult result_expr
 670       rhs_ty       = exprType fail_expr
 671         -- Use exprType of fail_expr, because won't refine in the case of failure!
 672     in
 673     matchSinglePat scrut hs_ctx pat rhs_ty match_result `thenDs` \ match_result' ->
 674     extractMatchResult match_result' fail_expr
 675
 676
 677 matchSinglePat :: CoreExpr -> HsMatchContext Name -> LPat Id
 678                -> Type -> MatchResult -> DsM MatchResult
 679 matchSinglePat (Var var) hs_ctx (L _ pat) ty match_result
 680   = getDOptsDs                          `thenDs` \ dflags ->
 681     getSrcSpanDs                        `thenDs` \ locn ->
 682     let
 683         match_fn dflags
 684            | dopt Opt_WarnSimplePatterns dflags = matchCheck ds_ctx
 685            | otherwise                          = match
 686            where
 687              ds_ctx = DsMatchContext hs_ctx locn
 688     in
 689     match_fn dflags [var] ty [EqnInfo { eqn_pats = [pat], eqn_rhs  = match_result }]
 690
 691 matchSinglePat scrut hs_ctx pat ty match_result
 692   = selectSimpleMatchVarL pat                           `thenDs` \ var ->
 693     matchSinglePat (Var var) hs_ctx pat ty match_result `thenDs` \ match_result' ->
 694     returnDs (adjustMatchResult (bindNonRec var scrut) match_result')
 695 \end{code}
 696
 697
 698 %************************************************************************
 699 %*                                                                      *
 700                 Pattern classification
 701 %*                                                                      *
 702 %************************************************************************
 703
 704 \begin{code}
 705 data PatGroup
 706   = PgAny               -- Immediate match: variables, wildcards,
 707                         --                  lazy patterns
 708   | PgCon DataCon       -- Constructor patterns (incl list, tuple)
 709   | PgLit Literal       -- Literal patterns
 710   | PgN   Literal       -- Overloaded literals
 711   | PgNpK Literal       -- n+k patterns
 712   | PgBang              -- Bang patterns
 713   | PgCo Type           -- Coercion patterns; the type is the type
 714                         --      of the pattern *inside*
 715
 716
 717 groupEquations :: [EquationInfo] -> [[(PatGroup, EquationInfo)]]
 718 -- If the result is of form [g1, g2, g3],
 719 -- (a) all the (pg,eq) pairs in g1 have the same pg
 720 -- (b) none of the gi are empty
 721 groupEquations eqns
 722   = runs same_gp [(patGroup (firstPat eqn), eqn) | eqn <- eqns]
 723   where
 724     same_gp :: (PatGroup,EquationInfo) -> (PatGroup,EquationInfo) -> Bool
 725     (pg1,_) `same_gp` (pg2,_) = pg1 `sameGroup` pg2
 726
 727 subGroups :: [(PatGroup, EquationInfo)] -> [[EquationInfo]]
 728 -- Input is a particular group.  The result sub-groups the
 729 -- equations by with particular constructor, literal etc they match.
 730 -- The order may be swizzled, so the matching should be order-independent
 731 subGroups groups = map (map snd) (equivClasses cmp groups)
 732   where
 733     (pg1, _) `cmp` (pg2, _) = pg1 `cmp_pg` pg2
 734     (PgCon c1) `cmp_pg` (PgCon c2) = c1 `compare` c2
 735     (PgLit l1) `cmp_pg` (PgLit l2) = l1 `compare` l2
 736     (PgN   l1) `cmp_pg` (PgN   l2) = l1 `compare` l2
 737         -- These are the only cases that are every sub-grouped
 738
 739 sameGroup :: PatGroup -> PatGroup -> Bool
 740 -- Same group means that a single case expression
 741 -- or test will suffice to match both, *and* the order
 742 -- of testing within the group is insignificant.
 743 sameGroup PgAny      PgAny      = True
 744 sameGroup PgBang     PgBang     = True
 745 sameGroup (PgCon _)  (PgCon _)  = True          -- One case expression
 746 sameGroup (PgLit _)  (PgLit _)  = True          -- One case expression
 747 sameGroup (PgN l1)   (PgN l2)   = True          -- Needs conditionals
 748 sameGroup (PgNpK l1) (PgNpK l2) = l1==l2        -- Order is significant
 749                                                 -- See Note [Order of n+k]
 750 sameGroup (PgCo t1)  (PgCo t2)  = t1 `coreEqType` t2
 751         -- CoPats are in the same goup only if the type of the
 752         -- enclosed pattern is the same. The patterns outside the CoPat
 753         -- always have the same type, so this boils down to saying that
 754         -- the two coercions are identical.
 755 sameGroup _          _          = False
 756
 757 patGroup :: Pat Id -> PatGroup
 758 patGroup (WildPat {})                 = PgAny
 759 patGroup (BangPat {})                 = PgBang
 760 patGroup (ConPatOut { pat_con = dc }) = PgCon (unLoc dc)
 761 patGroup (LitPat lit)                 = PgLit (hsLitKey lit)
 762 patGroup (NPat olit mb_neg _ _)       = PgN   (hsOverLitKey olit (isJust mb_neg))
 763 patGroup (NPlusKPat _ olit _ _)       = PgNpK (hsOverLitKey olit False)
 764 patGroup (CoPat _ p _)                = PgCo  (hsPatType p)     -- Type of inner pattern
 765 patGroup pat = pprPanic "patGroup" (ppr pat)
 766 \end{code}
 767
 768 Note [Order of n+k]
 769 ~~~~~~~~~~~~~~~~~~~
 770 WATCH OUT!  Consider
 771
 772         f (n+1) = ...
 773         f (n+2) = ...
 774         f (n+1) = ...
 775
 776 We can't group the first and third together, because the second may match
 777 the same thing as the first.  Contrast
 778         f 1 = ...
 779         f 2 = ...
 780         f 1 = ...
 781 where we can group the first and third.  Hence we don't regard (n+1) and
 782 (n+2) as part of the same group.