ghc/compiler/deSugar/Match.lhs

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