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