ghc/compiler/deSugar/Match.lhs

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