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