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