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