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