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