1{- 2(c) The University of Glasgow 2006 3(c) The GRASP/AQUA Project, Glasgow University, 1992-1998 4 5 6The @match@ function 7-} 8 9{-# LANGUAGE CPP #-} 10{-# LANGUAGE TypeFamilies #-} 11{-# LANGUAGE ViewPatterns #-} 12 13module Match ( match, matchEquations, matchWrapper, matchSimply 14 , matchSinglePat, matchSinglePatVar ) where 15 16#include "HsVersions.h" 17 18import GhcPrelude 19 20import {-#SOURCE#-} DsExpr (dsLExpr, dsSyntaxExpr) 21 22import BasicTypes ( Origin(..) ) 23import DynFlags 24import GHC.Hs 25import TcHsSyn 26import TcEvidence 27import TcRnMonad 28import GHC.HsToCore.PmCheck 29import CoreSyn 30import Literal 31import CoreUtils 32import MkCore 33import DsMonad 34import DsBinds 35import DsGRHSs 36import DsUtils 37import Id 38import ConLike 39import DataCon 40import PatSyn 41import MatchCon 42import MatchLit 43import Type 44import Coercion ( eqCoercion ) 45import TyCon( isNewTyCon ) 46import TysWiredIn 47import SrcLoc 48import Maybes 49import Util 50import Name 51import Outputable 52import BasicTypes ( isGenerated, il_value, fl_value ) 53import FastString 54import Unique 55import UniqDFM 56 57import Control.Monad( when, unless ) 58import Data.List ( groupBy ) 59import qualified Data.Map as Map 60 61{- 62************************************************************************ 63* * 64 The main matching function 65* * 66************************************************************************ 67 68The function @match@ is basically the same as in the Wadler chapter 69from "The Implementation of Functional Programming Languages", 70except it is monadised, to carry around the name supply, info about 71annotations, etc. 72 73Notes on @match@'s arguments, assuming $m$ equations and $n$ patterns: 74\begin{enumerate} 75\item 76A list of $n$ variable names, those variables presumably bound to the 77$n$ expressions being matched against the $n$ patterns. Using the 78list of $n$ expressions as the first argument showed no benefit and 79some inelegance. 80 81\item 82The second argument, a list giving the ``equation info'' for each of 83the $m$ equations: 84\begin{itemize} 85\item 86the $n$ patterns for that equation, and 87\item 88a list of Core bindings [@(Id, CoreExpr)@ pairs] to be ``stuck on 89the front'' of the matching code, as in: 90\begin{verbatim} 91let <binds> 92in <matching-code> 93\end{verbatim} 94\item 95and finally: (ToDo: fill in) 96 97The right way to think about the ``after-match function'' is that it 98is an embryonic @CoreExpr@ with a ``hole'' at the end for the 99final ``else expression''. 100\end{itemize} 101 102There is a data type, @EquationInfo@, defined in module @DsMonad@. 103 104An experiment with re-ordering this information about equations (in 105particular, having the patterns available in column-major order) 106showed no benefit. 107 108\item 109A default expression---what to evaluate if the overall pattern-match 110fails. This expression will (almost?) always be 111a measly expression @Var@, unless we know it will only be used once 112(as we do in @glue_success_exprs@). 113 114Leaving out this third argument to @match@ (and slamming in lots of 115@Var "fail"@s) is a positively {\em bad} idea, because it makes it 116impossible to share the default expressions. (Also, it stands no 117chance of working in our post-upheaval world of @Locals@.) 118\end{enumerate} 119 120Note: @match@ is often called via @matchWrapper@ (end of this module), 121a function that does much of the house-keeping that goes with a call 122to @match@. 123 124It is also worth mentioning the {\em typical} way a block of equations 125is desugared with @match@. At each stage, it is the first column of 126patterns that is examined. The steps carried out are roughly: 127\begin{enumerate} 128\item 129Tidy the patterns in column~1 with @tidyEqnInfo@ (this may add 130bindings to the second component of the equation-info): 131\item 132Now {\em unmix} the equations into {\em blocks} [w\/ local function 133@match_groups@], in which the equations in a block all have the same 134 match group. 135(see ``the mixture rule'' in SLPJ). 136\item 137Call the right match variant on each block of equations; it will do the 138appropriate thing for each kind of column-1 pattern. 139\end{enumerate} 140 141We are a little more paranoid about the ``empty rule'' (SLPJ, p.~87) 142than the Wadler-chapter code for @match@ (p.~93, first @match@ clause). 143And gluing the ``success expressions'' together isn't quite so pretty. 144 145This @match@ uses @tidyEqnInfo@ 146to get `as'- and `twiddle'-patterns out of the way (tidying), before 147applying ``the mixture rule'' (SLPJ, p.~88) [which really {\em 148un}mixes the equations], producing a list of equation-info 149blocks, each block having as its first column patterns compatible with each other. 150 151Note [Match Ids] 152~~~~~~~~~~~~~~~~ 153Most of the matching functions take an Id or [Id] as argument. This Id 154is the scrutinee(s) of the match. The desugared expression may 155sometimes use that Id in a local binding or as a case binder. So it 156should not have an External name; Lint rejects non-top-level binders 157with External names (#13043). 158 159See also Note [Localise pattern binders] in DsUtils 160-} 161 162type MatchId = Id -- See Note [Match Ids] 163 164match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with 165 -- ^ See Note [Match Ids] 166 -> Type -- ^ Type of the case expression 167 -> [EquationInfo] -- ^ Info about patterns, etc. (type synonym below) 168 -> DsM MatchResult -- ^ Desugared result! 169 170match [] ty eqns 171 = ASSERT2( not (null eqns), ppr ty ) 172 return (foldr1 combineMatchResults match_results) 173 where 174 match_results = [ ASSERT( null (eqn_pats eqn) ) 175 eqn_rhs eqn 176 | eqn <- eqns ] 177 178match vars@(v:_) ty eqns -- Eqns *can* be empty 179 = ASSERT2( all (isInternalName . idName) vars, ppr vars ) 180 do { dflags <- getDynFlags 181 -- Tidy the first pattern, generating 182 -- auxiliary bindings if necessary 183 ; (aux_binds, tidy_eqns) <- mapAndUnzipM (tidyEqnInfo v) eqns 184 185 -- Group the equations and match each group in turn 186 ; let grouped = groupEquations dflags tidy_eqns 187 188 -- print the view patterns that are commoned up to help debug 189 ; whenDOptM Opt_D_dump_view_pattern_commoning (debug grouped) 190 191 ; match_results <- match_groups grouped 192 ; return (adjustMatchResult (foldr (.) id aux_binds) $ 193 foldr1 combineMatchResults match_results) } 194 where 195 dropGroup :: [(PatGroup,EquationInfo)] -> [EquationInfo] 196 dropGroup = map snd 197 198 match_groups :: [[(PatGroup,EquationInfo)]] -> DsM [MatchResult] 199 -- Result list of [MatchResult] is always non-empty 200 match_groups [] = matchEmpty v ty 201 match_groups gs = mapM match_group gs 202 203 match_group :: [(PatGroup,EquationInfo)] -> DsM MatchResult 204 match_group [] = panic "match_group" 205 match_group eqns@((group,_) : _) 206 = case group of 207 PgCon {} -> matchConFamily vars ty (subGroupUniq [(c,e) | (PgCon c, e) <- eqns]) 208 PgSyn {} -> matchPatSyn vars ty (dropGroup eqns) 209 PgLit {} -> matchLiterals vars ty (subGroupOrd [(l,e) | (PgLit l, e) <- eqns]) 210 PgAny -> matchVariables vars ty (dropGroup eqns) 211 PgN {} -> matchNPats vars ty (dropGroup eqns) 212 PgOverS {}-> matchNPats vars ty (dropGroup eqns) 213 PgNpK {} -> matchNPlusKPats vars ty (dropGroup eqns) 214 PgBang -> matchBangs vars ty (dropGroup eqns) 215 PgCo {} -> matchCoercion vars ty (dropGroup eqns) 216 PgView {} -> matchView vars ty (dropGroup eqns) 217 PgOverloadedList -> matchOverloadedList vars ty (dropGroup eqns) 218 219 -- FIXME: we should also warn about view patterns that should be 220 -- commoned up but are not 221 222 -- print some stuff to see what's getting grouped 223 -- use -dppr-debug to see the resolution of overloaded literals 224 debug eqns = 225 let gs = map (\group -> foldr (\ (p,_) -> \acc -> 226 case p of PgView e _ -> e:acc 227 _ -> acc) [] group) eqns 228 maybeWarn [] = return () 229 maybeWarn l = warnDs NoReason (vcat l) 230 in 231 maybeWarn $ (map (\g -> text "Putting these view expressions into the same case:" <+> (ppr g)) 232 (filter (not . null) gs)) 233 234matchEmpty :: MatchId -> Type -> DsM [MatchResult] 235-- See Note [Empty case expressions] 236matchEmpty var res_ty 237 = return [MatchResult CanFail mk_seq] 238 where 239 mk_seq fail = return $ mkWildCase (Var var) (idType var) res_ty 240 [(DEFAULT, [], fail)] 241 242matchVariables :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult 243-- Real true variables, just like in matchVar, SLPJ p 94 244-- No binding to do: they'll all be wildcards by now (done in tidy) 245matchVariables (_:vars) ty eqns = match vars ty (shiftEqns eqns) 246matchVariables [] _ _ = panic "matchVariables" 247 248matchBangs :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult 249matchBangs (var:vars) ty eqns 250 = do { match_result <- match (var:vars) ty $ 251 map (decomposeFirstPat getBangPat) eqns 252 ; return (mkEvalMatchResult var ty match_result) } 253matchBangs [] _ _ = panic "matchBangs" 254 255matchCoercion :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult 256-- Apply the coercion to the match variable and then match that 257matchCoercion (var:vars) ty (eqns@(eqn1:_)) 258 = do { let CoPat _ co pat _ = firstPat eqn1 259 ; let pat_ty' = hsPatType pat 260 ; var' <- newUniqueId var pat_ty' 261 ; match_result <- match (var':vars) ty $ 262 map (decomposeFirstPat getCoPat) eqns 263 ; core_wrap <- dsHsWrapper co 264 ; let bind = NonRec var' (core_wrap (Var var)) 265 ; return (mkCoLetMatchResult bind match_result) } 266matchCoercion _ _ _ = panic "matchCoercion" 267 268matchView :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult 269-- Apply the view function to the match variable and then match that 270matchView (var:vars) ty (eqns@(eqn1:_)) 271 = do { -- we could pass in the expr from the PgView, 272 -- but this needs to extract the pat anyway 273 -- to figure out the type of the fresh variable 274 let ViewPat _ viewExpr (dL->L _ pat) = firstPat eqn1 275 -- do the rest of the compilation 276 ; let pat_ty' = hsPatType pat 277 ; var' <- newUniqueId var pat_ty' 278 ; match_result <- match (var':vars) ty $ 279 map (decomposeFirstPat getViewPat) eqns 280 -- compile the view expressions 281 ; viewExpr' <- dsLExpr viewExpr 282 ; return (mkViewMatchResult var' 283 (mkCoreAppDs (text "matchView") viewExpr' (Var var)) 284 match_result) } 285matchView _ _ _ = panic "matchView" 286 287matchOverloadedList :: [MatchId] -> Type -> [EquationInfo] -> DsM MatchResult 288matchOverloadedList (var:vars) ty (eqns@(eqn1:_)) 289-- Since overloaded list patterns are treated as view patterns, 290-- the code is roughly the same as for matchView 291 = do { let ListPat (ListPatTc elt_ty (Just (_,e))) _ = firstPat eqn1 292 ; var' <- newUniqueId var (mkListTy elt_ty) -- we construct the overall type by hand 293 ; match_result <- match (var':vars) ty $ 294 map (decomposeFirstPat getOLPat) eqns -- getOLPat builds the pattern inside as a non-overloaded version of the overloaded list pattern 295 ; e' <- dsSyntaxExpr e [Var var] 296 ; return (mkViewMatchResult var' e' match_result) } 297matchOverloadedList _ _ _ = panic "matchOverloadedList" 298 299-- decompose the first pattern and leave the rest alone 300decomposeFirstPat :: (Pat GhcTc -> Pat GhcTc) -> EquationInfo -> EquationInfo 301decomposeFirstPat extractpat (eqn@(EqnInfo { eqn_pats = pat : pats })) 302 = eqn { eqn_pats = extractpat pat : pats} 303decomposeFirstPat _ _ = panic "decomposeFirstPat" 304 305getCoPat, getBangPat, getViewPat, getOLPat :: Pat GhcTc -> Pat GhcTc 306getCoPat (CoPat _ _ pat _) = pat 307getCoPat _ = panic "getCoPat" 308getBangPat (BangPat _ pat ) = unLoc pat 309getBangPat _ = panic "getBangPat" 310getViewPat (ViewPat _ _ pat) = unLoc pat 311getViewPat _ = panic "getViewPat" 312getOLPat (ListPat (ListPatTc ty (Just _)) pats) 313 = ListPat (ListPatTc ty Nothing) pats 314getOLPat _ = panic "getOLPat" 315 316{- 317Note [Empty case alternatives] 318~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 319The list of EquationInfo can be empty, arising from 320 case x of {} or \case {} 321In that situation we desugar to 322 case x of { _ -> error "pattern match failure" } 323The *desugarer* isn't certain whether there really should be no 324alternatives, so it adds a default case, as it always does. A later 325pass may remove it if it's inaccessible. (See also Note [Empty case 326alternatives] in CoreSyn.) 327 328We do *not* desugar simply to 329 error "empty case" 330or some such, because 'x' might be bound to (error "hello"), in which 331case we want to see that "hello" exception, not (error "empty case"). 332See also Note [Case elimination: lifted case] in Simplify. 333 334 335************************************************************************ 336* * 337 Tidying patterns 338* * 339************************************************************************ 340 341Tidy up the leftmost pattern in an @EquationInfo@, given the variable @v@ 342which will be scrutinised. 343 344This makes desugaring the pattern match simpler by transforming some of 345the patterns to simpler forms. (Tuples to Constructor Patterns) 346 347Among other things in the resulting Pattern: 348* Variables and irrefutable(lazy) patterns are replaced by Wildcards 349* As patterns are replaced by the patterns they wrap. 350 351The bindings created by the above patterns are put into the returned wrapper 352instead. 353 354This means a definition of the form: 355 f x = rhs 356when called with v get's desugared to the equivalent of: 357 let x = v 358 in 359 f _ = rhs 360 361The same principle holds for as patterns (@) and 362irrefutable/lazy patterns (~). 363In the case of irrefutable patterns the irrefutable pattern is pushed into 364the binding. 365 366Pattern Constructors which only represent syntactic sugar are converted into 367their desugared representation. 368This usually means converting them to Constructor patterns but for some 369depends on enabled extensions. (Eg OverloadedLists) 370 371GHC also tries to convert overloaded Literals into regular ones. 372 373The result of this tidying is that the column of patterns will include 374only these which can be assigned a PatternGroup (see patGroup). 375 376-} 377 378tidyEqnInfo :: Id -> EquationInfo 379 -> DsM (DsWrapper, EquationInfo) 380 -- DsM'd because of internal call to dsLHsBinds 381 -- and mkSelectorBinds. 382 -- "tidy1" does the interesting stuff, looking at 383 -- one pattern and fiddling the list of bindings. 384 -- 385 -- POST CONDITION: head pattern in the EqnInfo is 386 -- one of these for which patGroup is defined. 387 388tidyEqnInfo _ (EqnInfo { eqn_pats = [] }) 389 = panic "tidyEqnInfo" 390 391tidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats, eqn_orig = orig }) 392 = do { (wrap, pat') <- tidy1 v orig pat 393 ; return (wrap, eqn { eqn_pats = do pat' : pats }) } 394 395tidy1 :: Id -- The Id being scrutinised 396 -> Origin -- Was this a pattern the user wrote? 397 -> Pat GhcTc -- The pattern against which it is to be matched 398 -> DsM (DsWrapper, -- Extra bindings to do before the match 399 Pat GhcTc) -- Equivalent pattern 400 401------------------------------------------------------- 402-- (pat', mr') = tidy1 v pat mr 403-- tidies the *outer level only* of pat, giving pat' 404-- It eliminates many pattern forms (as-patterns, variable patterns, 405-- list patterns, etc) and returns any created bindings in the wrapper. 406 407tidy1 v o (ParPat _ pat) = tidy1 v o (unLoc pat) 408tidy1 v o (SigPat _ pat _) = tidy1 v o (unLoc pat) 409tidy1 _ _ (WildPat ty) = return (idDsWrapper, WildPat ty) 410tidy1 v o (BangPat _ (dL->L l p)) = tidy_bang_pat v o l p 411 412 -- case v of { x -> mr[] } 413 -- = case v of { _ -> let x=v in mr[] } 414tidy1 v _ (VarPat _ (dL->L _ var)) 415 = return (wrapBind var v, WildPat (idType var)) 416 417 -- case v of { x@p -> mr[] } 418 -- = case v of { p -> let x=v in mr[] } 419tidy1 v o (AsPat _ (dL->L _ var) pat) 420 = do { (wrap, pat') <- tidy1 v o (unLoc pat) 421 ; return (wrapBind var v . wrap, pat') } 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 434tidy1 v _ (LazyPat _ pat) 435 -- This is a convenient place to check for unlifted types under a lazy pattern. 436 -- Doing this check during type-checking is unsatisfactory because we may 437 -- not fully know the zonked types yet. We sure do here. 438 = do { let unlifted_bndrs = filter (isUnliftedType . idType) (collectPatBinders pat) 439 ; unless (null unlifted_bndrs) $ 440 putSrcSpanDs (getLoc pat) $ 441 errDs (hang (text "A lazy (~) pattern cannot bind variables of unlifted type." $$ 442 text "Unlifted variables:") 443 2 (vcat (map (\id -> ppr id <+> dcolon <+> ppr (idType id)) 444 unlifted_bndrs))) 445 446 ; (_,sel_prs) <- mkSelectorBinds [] pat (Var v) 447 ; let sel_binds = [NonRec b rhs | (b,rhs) <- sel_prs] 448 ; return (mkCoreLets sel_binds, WildPat (idType v)) } 449 450tidy1 _ _ (ListPat (ListPatTc ty Nothing) pats ) 451 = return (idDsWrapper, unLoc list_ConPat) 452 where 453 list_ConPat = foldr (\ x y -> mkPrefixConPat consDataCon [x, y] [ty]) 454 (mkNilPat ty) 455 pats 456 457tidy1 _ _ (TuplePat tys pats boxity) 458 = return (idDsWrapper, unLoc tuple_ConPat) 459 where 460 arity = length pats 461 tuple_ConPat = mkPrefixConPat (tupleDataCon boxity arity) pats tys 462 463tidy1 _ _ (SumPat tys pat alt arity) 464 = return (idDsWrapper, unLoc sum_ConPat) 465 where 466 sum_ConPat = mkPrefixConPat (sumDataCon alt arity) [pat] tys 467 468-- LitPats: we *might* be able to replace these w/ a simpler form 469tidy1 _ o (LitPat _ lit) 470 = do { unless (isGenerated o) $ 471 warnAboutOverflowedLit lit 472 ; return (idDsWrapper, tidyLitPat lit) } 473 474-- NPats: we *might* be able to replace these w/ a simpler form 475tidy1 _ o (NPat ty (dL->L _ lit@OverLit { ol_val = v }) mb_neg eq) 476 = do { unless (isGenerated o) $ 477 let lit' | Just _ <- mb_neg = lit{ ol_val = negateOverLitVal v } 478 | otherwise = lit 479 in warnAboutOverflowedOverLit lit' 480 ; return (idDsWrapper, tidyNPat lit mb_neg eq ty) } 481 482-- NPlusKPat: we may want to warn about the literals 483tidy1 _ o n@(NPlusKPat _ _ (dL->L _ lit1) lit2 _ _) 484 = do { unless (isGenerated o) $ do 485 warnAboutOverflowedOverLit lit1 486 warnAboutOverflowedOverLit lit2 487 ; return (idDsWrapper, n) } 488 489-- Everything else goes through unchanged... 490tidy1 _ _ non_interesting_pat 491 = return (idDsWrapper, non_interesting_pat) 492 493-------------------- 494tidy_bang_pat :: Id -> Origin -> SrcSpan -> Pat GhcTc 495 -> DsM (DsWrapper, Pat GhcTc) 496 497-- Discard par/sig under a bang 498tidy_bang_pat v o _ (ParPat _ (dL->L l p)) = tidy_bang_pat v o l p 499tidy_bang_pat v o _ (SigPat _ (dL->L l p) _) = tidy_bang_pat v o l p 500 501-- Push the bang-pattern inwards, in the hope that 502-- it may disappear next time 503tidy_bang_pat v o l (AsPat x v' p) 504 = tidy1 v o (AsPat x v' (cL l (BangPat noExtField p))) 505tidy_bang_pat v o l (CoPat x w p t) 506 = tidy1 v o (CoPat x w (BangPat noExtField (cL l p)) t) 507 508-- Discard bang around strict pattern 509tidy_bang_pat v o _ p@(LitPat {}) = tidy1 v o p 510tidy_bang_pat v o _ p@(ListPat {}) = tidy1 v o p 511tidy_bang_pat v o _ p@(TuplePat {}) = tidy1 v o p 512tidy_bang_pat v o _ p@(SumPat {}) = tidy1 v o p 513 514-- Data/newtype constructors 515tidy_bang_pat v o l p@(ConPatOut { pat_con = (dL->L _ (RealDataCon dc)) 516 , pat_args = args 517 , pat_arg_tys = arg_tys }) 518 -- Newtypes: push bang inwards (#9844) 519 = 520 if isNewTyCon (dataConTyCon dc) 521 then tidy1 v o (p { pat_args = push_bang_into_newtype_arg l ty args }) 522 else tidy1 v o p -- Data types: discard the bang 523 where 524 (ty:_) = dataConInstArgTys dc arg_tys 525 526------------------- 527-- Default case, leave the bang there: 528-- VarPat, 529-- LazyPat, 530-- WildPat, 531-- ViewPat, 532-- pattern synonyms (ConPatOut with PatSynCon) 533-- NPat, 534-- NPlusKPat 535-- 536-- For LazyPat, remember that it's semantically like a VarPat 537-- i.e. !(~p) is not like ~p, or p! (#8952) 538-- 539-- NB: SigPatIn, ConPatIn should not happen 540 541tidy_bang_pat _ _ l p = return (idDsWrapper, BangPat noExtField (cL l p)) 542 543------------------- 544push_bang_into_newtype_arg :: SrcSpan 545 -> Type -- The type of the argument we are pushing 546 -- onto 547 -> HsConPatDetails GhcTc -> HsConPatDetails GhcTc 548-- See Note [Bang patterns and newtypes] 549-- We are transforming !(N p) into (N !p) 550push_bang_into_newtype_arg l _ty (PrefixCon (arg:args)) 551 = ASSERT( null args) 552 PrefixCon [cL l (BangPat noExtField arg)] 553push_bang_into_newtype_arg l _ty (RecCon rf) 554 | HsRecFields { rec_flds = (dL->L lf fld) : flds } <- rf 555 , HsRecField { hsRecFieldArg = arg } <- fld 556 = ASSERT( null flds) 557 RecCon (rf { rec_flds = [cL lf (fld { hsRecFieldArg 558 = cL l (BangPat noExtField arg) })] }) 559push_bang_into_newtype_arg l ty (RecCon rf) -- If a user writes !(T {}) 560 | HsRecFields { rec_flds = [] } <- rf 561 = PrefixCon [cL l (BangPat noExtField (noLoc (WildPat ty)))] 562push_bang_into_newtype_arg _ _ cd 563 = pprPanic "push_bang_into_newtype_arg" (pprConArgs cd) 564 565{- 566Note [Bang patterns and newtypes] 567~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 568For the pattern !(Just pat) we can discard the bang, because 569the pattern is strict anyway. But for !(N pat), where 570 newtype NT = N Int 571we definitely can't discard the bang. #9844. 572 573So what we do is to push the bang inwards, in the hope that it will 574get discarded there. So we transform 575 !(N pat) into (N !pat) 576 577But what if there is nothing to push the bang onto? In at least one instance 578a user has written !(N {}) which we translate into (N !_). See #13215 579 580 581\noindent 582{\bf Previous @matchTwiddled@ stuff:} 583 584Now we get to the only interesting part; note: there are choices for 585translation [from Simon's notes]; translation~1: 586\begin{verbatim} 587deTwiddle [s,t] e 588\end{verbatim} 589returns 590\begin{verbatim} 591[ w = e, 592 s = case w of [s,t] -> s 593 t = case w of [s,t] -> t 594] 595\end{verbatim} 596 597Here \tr{w} is a fresh variable, and the \tr{w}-binding prevents multiple 598evaluation of \tr{e}. An alternative translation (No.~2): 599\begin{verbatim} 600[ w = case e of [s,t] -> (s,t) 601 s = case w of (s,t) -> s 602 t = case w of (s,t) -> t 603] 604\end{verbatim} 605 606************************************************************************ 607* * 608\subsubsection[improved-unmixing]{UNIMPLEMENTED idea for improved unmixing} 609* * 610************************************************************************ 611 612We might be able to optimise unmixing when confronted by 613only-one-constructor-possible, of which tuples are the most notable 614examples. Consider: 615\begin{verbatim} 616f (a,b,c) ... = ... 617f d ... (e:f) = ... 618f (g,h,i) ... = ... 619f j ... = ... 620\end{verbatim} 621This definition would normally be unmixed into four equation blocks, 622one per equation. But it could be unmixed into just one equation 623block, because if the one equation matches (on the first column), 624the others certainly will. 625 626You have to be careful, though; the example 627\begin{verbatim} 628f j ... = ... 629------------------- 630f (a,b,c) ... = ... 631f d ... (e:f) = ... 632f (g,h,i) ... = ... 633\end{verbatim} 634{\em must} be broken into two blocks at the line shown; otherwise, you 635are forcing unnecessary evaluation. In any case, the top-left pattern 636always gives the cue. You could then unmix blocks into groups of... 637\begin{description} 638\item[all variables:] 639As it is now. 640\item[constructors or variables (mixed):] 641Need to make sure the right names get bound for the variable patterns. 642\item[literals or variables (mixed):] 643Presumably just a variant on the constructor case (as it is now). 644\end{description} 645 646************************************************************************ 647* * 648* matchWrapper: a convenient way to call @match@ * 649* * 650************************************************************************ 651\subsection[matchWrapper]{@matchWrapper@: a convenient interface to @match@} 652 653Calls to @match@ often involve similar (non-trivial) work; that work 654is collected here, in @matchWrapper@. This function takes as 655arguments: 656\begin{itemize} 657\item 658Typechecked @Matches@ (of a function definition, or a case or lambda 659expression)---the main input; 660\item 661An error message to be inserted into any (runtime) pattern-matching 662failure messages. 663\end{itemize} 664 665As results, @matchWrapper@ produces: 666\begin{itemize} 667\item 668A list of variables (@Locals@) that the caller must ``promise'' to 669bind to appropriate values; and 670\item 671a @CoreExpr@, the desugared output (main result). 672\end{itemize} 673 674The main actions of @matchWrapper@ include: 675\begin{enumerate} 676\item 677Flatten the @[TypecheckedMatch]@ into a suitable list of 678@EquationInfo@s. 679\item 680Create as many new variables as there are patterns in a pattern-list 681(in any one of the @EquationInfo@s). 682\item 683Create a suitable ``if it fails'' expression---a call to @error@ using 684the error-string input; the {\em type} of this fail value can be found 685by examining one of the RHS expressions in one of the @EquationInfo@s. 686\item 687Call @match@ with all of this information! 688\end{enumerate} 689-} 690 691matchWrapper 692 :: HsMatchContext Name -- ^ For shadowing warning messages 693 -> Maybe (LHsExpr GhcTc) -- ^ Scrutinee. (Just scrut) for a case expr 694 -- case scrut of { p1 -> e1 ... } 695 -- (and in this case the MatchGroup will 696 -- have all singleton patterns) 697 -- Nothing for a function definition 698 -- f p1 q1 = ... -- No "scrutinee" 699 -- f p2 q2 = ... -- in this case 700 -> MatchGroup GhcTc (LHsExpr GhcTc) -- ^ Matches being desugared 701 -> DsM ([Id], CoreExpr) -- ^ Results (usually passed to 'match') 702 703{- 704 There is one small problem with the Lambda Patterns, when somebody 705 writes something similar to: 706\begin{verbatim} 707 (\ (x:xs) -> ...) 708\end{verbatim} 709 he/she don't want a warning about incomplete patterns, that is done with 710 the flag @opt_WarnSimplePatterns@. 711 This problem also appears in the: 712\begin{itemize} 713\item @do@ patterns, but if the @do@ can fail 714 it creates another equation if the match can fail 715 (see @DsExpr.doDo@ function) 716\item @let@ patterns, are treated by @matchSimply@ 717 List Comprension Patterns, are treated by @matchSimply@ also 718\end{itemize} 719 720We can't call @matchSimply@ with Lambda patterns, 721due to the fact that lambda patterns can have more than 722one pattern, and match simply only accepts one pattern. 723 724JJQC 30-Nov-1997 725-} 726 727matchWrapper ctxt mb_scr (MG { mg_alts = (dL->L _ matches) 728 , mg_ext = MatchGroupTc arg_tys rhs_ty 729 , mg_origin = origin }) 730 = do { dflags <- getDynFlags 731 ; locn <- getSrcSpanDs 732 733 ; new_vars <- case matches of 734 [] -> mapM newSysLocalDsNoLP arg_tys 735 (m:_) -> selectMatchVars (map unLoc (hsLMatchPats m)) 736 737 ; eqns_info <- mapM (mk_eqn_info new_vars) matches 738 739 -- Pattern match check warnings for /this match-group/ 740 ; when (isMatchContextPmChecked dflags origin ctxt) $ 741 addScrutTmCs mb_scr new_vars $ 742 -- See Note [Type and Term Equality Propagation] 743 checkMatches dflags (DsMatchContext ctxt locn) new_vars matches 744 745 ; result_expr <- handleWarnings $ 746 matchEquations ctxt new_vars eqns_info rhs_ty 747 ; return (new_vars, result_expr) } 748 where 749 -- Called once per equation in the match, or alternative in the case 750 mk_eqn_info vars (dL->L _ (Match { m_pats = pats, m_grhss = grhss })) 751 = do { dflags <- getDynFlags 752 ; let upats = map (unLoc . decideBangHood dflags) pats 753 dicts = collectEvVarsPats upats 754 755 ; match_result <- 756 -- Extend the environment with knowledge about 757 -- the matches before desguaring the RHS 758 -- See Note [Type and Term Equality Propagation] 759 applyWhen (needToRunPmCheck dflags origin) 760 (addTyCsDs dicts . addScrutTmCs mb_scr vars . addPatTmCs upats vars) 761 (dsGRHSs ctxt grhss rhs_ty) 762 763 ; return (EqnInfo { eqn_pats = upats 764 , eqn_orig = FromSource 765 , eqn_rhs = match_result }) } 766 mk_eqn_info _ (dL->L _ (XMatch nec)) = noExtCon nec 767 mk_eqn_info _ _ = panic "mk_eqn_info: Impossible Match" -- due to #15884 768 769 handleWarnings = if isGenerated origin 770 then discardWarningsDs 771 else id 772matchWrapper _ _ (XMatchGroup nec) = noExtCon nec 773 774matchEquations :: HsMatchContext Name 775 -> [MatchId] -> [EquationInfo] -> Type 776 -> DsM CoreExpr 777matchEquations ctxt vars eqns_info rhs_ty 778 = do { let error_doc = matchContextErrString ctxt 779 780 ; match_result <- match vars rhs_ty eqns_info 781 782 ; fail_expr <- mkErrorAppDs pAT_ERROR_ID rhs_ty error_doc 783 ; extractMatchResult match_result fail_expr } 784 785{- 786************************************************************************ 787* * 788\subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern} 789* * 790************************************************************************ 791 792@mkSimpleMatch@ is a wrapper for @match@ which deals with the 793situation where we want to match a single expression against a single 794pattern. It returns an expression. 795-} 796 797matchSimply :: CoreExpr -- ^ Scrutinee 798 -> HsMatchContext Name -- ^ Match kind 799 -> LPat GhcTc -- ^ Pattern it should match 800 -> CoreExpr -- ^ Return this if it matches 801 -> CoreExpr -- ^ Return this if it doesn't 802 -> DsM CoreExpr 803-- Do not warn about incomplete patterns; see matchSinglePat comments 804matchSimply scrut hs_ctx pat result_expr fail_expr = do 805 let 806 match_result = cantFailMatchResult result_expr 807 rhs_ty = exprType fail_expr 808 -- Use exprType of fail_expr, because won't refine in the case of failure! 809 match_result' <- matchSinglePat scrut hs_ctx pat rhs_ty match_result 810 extractMatchResult match_result' fail_expr 811 812matchSinglePat :: CoreExpr -> HsMatchContext Name -> LPat GhcTc 813 -> Type -> MatchResult -> DsM MatchResult 814-- matchSinglePat ensures that the scrutinee is a variable 815-- and then calls matchSinglePatVar 816-- 817-- matchSinglePat does not warn about incomplete patterns 818-- Used for things like [ e | pat <- stuff ], where 819-- incomplete patterns are just fine 820 821matchSinglePat (Var var) ctx pat ty match_result 822 | not (isExternalName (idName var)) 823 = matchSinglePatVar var ctx pat ty match_result 824 825matchSinglePat scrut hs_ctx pat ty match_result 826 = do { var <- selectSimpleMatchVarL pat 827 ; match_result' <- matchSinglePatVar var hs_ctx pat ty match_result 828 ; return (adjustMatchResult (bindNonRec var scrut) match_result') } 829 830matchSinglePatVar :: Id -- See Note [Match Ids] 831 -> HsMatchContext Name -> LPat GhcTc 832 -> Type -> MatchResult -> DsM MatchResult 833matchSinglePatVar var ctx pat ty match_result 834 = ASSERT2( isInternalName (idName var), ppr var ) 835 do { dflags <- getDynFlags 836 ; locn <- getSrcSpanDs 837 838 -- Pattern match check warnings 839 ; checkSingle dflags (DsMatchContext ctx locn) var (unLoc pat) 840 841 ; let eqn_info = EqnInfo { eqn_pats = [unLoc (decideBangHood dflags pat)] 842 , eqn_orig = FromSource 843 , eqn_rhs = match_result } 844 ; match [var] ty [eqn_info] } 845 846 847{- 848************************************************************************ 849* * 850 Pattern classification 851* * 852************************************************************************ 853-} 854 855data PatGroup 856 = PgAny -- Immediate match: variables, wildcards, 857 -- lazy patterns 858 | PgCon DataCon -- Constructor patterns (incl list, tuple) 859 | PgSyn PatSyn [Type] -- See Note [Pattern synonym groups] 860 | PgLit Literal -- Literal patterns 861 | PgN Rational -- Overloaded numeric literals; 862 -- see Note [Don't use Literal for PgN] 863 | PgOverS FastString -- Overloaded string literals 864 | PgNpK Integer -- n+k patterns 865 | PgBang -- Bang patterns 866 | PgCo Type -- Coercion patterns; the type is the type 867 -- of the pattern *inside* 868 | PgView (LHsExpr GhcTc) -- view pattern (e -> p): 869 -- the LHsExpr is the expression e 870 Type -- the Type is the type of p (equivalently, the result type of e) 871 | PgOverloadedList 872 873{- Note [Don't use Literal for PgN] 874~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 875Previously we had, as PatGroup constructors 876 877 | ... 878 | PgN Literal -- Overloaded literals 879 | PgNpK Literal -- n+k patterns 880 | ... 881 882But Literal is really supposed to represent an *unboxed* literal, like Int#. 883We were sticking the literal from, say, an overloaded numeric literal pattern 884into a LitInt constructor. This didn't really make sense; and we now have 885the invariant that value in a LitInt must be in the range of the target 886machine's Int# type, and an overloaded literal could meaningfully be larger. 887 888Solution: For pattern grouping purposes, just store the literal directly in 889the PgN constructor as a Rational if numeric, and add a PgOverStr constructor 890for overloaded strings. 891-} 892 893groupEquations :: DynFlags -> [EquationInfo] -> [[(PatGroup, EquationInfo)]] 894-- If the result is of form [g1, g2, g3], 895-- (a) all the (pg,eq) pairs in g1 have the same pg 896-- (b) none of the gi are empty 897-- The ordering of equations is unchanged 898groupEquations dflags eqns 899 = groupBy same_gp [(patGroup dflags (firstPat eqn), eqn) | eqn <- eqns] 900 where 901 same_gp :: (PatGroup,EquationInfo) -> (PatGroup,EquationInfo) -> Bool 902 (pg1,_) `same_gp` (pg2,_) = pg1 `sameGroup` pg2 903 904subGroup :: (m -> [[EquationInfo]]) -- Map.elems 905 -> m -- Map.empty 906 -> (a -> m -> Maybe [EquationInfo]) -- Map.lookup 907 -> (a -> [EquationInfo] -> m -> m) -- Map.insert 908 -> [(a, EquationInfo)] -> [[EquationInfo]] 909-- Input is a particular group. The result sub-groups the 910-- equations by with particular constructor, literal etc they match. 911-- Each sub-list in the result has the same PatGroup 912-- See Note [Take care with pattern order] 913-- Parameterized by map operations to allow different implementations 914-- and constraints, eg. types without Ord instance. 915subGroup elems empty lookup insert group 916 = map reverse $ elems $ foldl' accumulate empty group 917 where 918 accumulate pg_map (pg, eqn) 919 = case lookup pg pg_map of 920 Just eqns -> insert pg (eqn:eqns) pg_map 921 Nothing -> insert pg [eqn] pg_map 922 -- pg_map :: Map a [EquationInfo] 923 -- Equations seen so far in reverse order of appearance 924 925subGroupOrd :: Ord a => [(a, EquationInfo)] -> [[EquationInfo]] 926subGroupOrd = subGroup Map.elems Map.empty Map.lookup Map.insert 927 928subGroupUniq :: Uniquable a => [(a, EquationInfo)] -> [[EquationInfo]] 929subGroupUniq = 930 subGroup eltsUDFM emptyUDFM (flip lookupUDFM) (\k v m -> addToUDFM m k v) 931 932{- Note [Pattern synonym groups] 933~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 934If we see 935 f (P a) = e1 936 f (P b) = e2 937 ... 938where P is a pattern synonym, can we put (P a -> e1) and (P b -> e2) in the 939same group? We can if P is a constructor, but /not/ if P is a pattern synonym. 940Consider (#11224) 941 -- readMaybe :: Read a => String -> Maybe a 942 pattern PRead :: Read a => () => a -> String 943 pattern PRead a <- (readMaybe -> Just a) 944 945 f (PRead (x::Int)) = e1 946 f (PRead (y::Bool)) = e2 947This is all fine: we match the string by trying to read an Int; if that 948fails we try to read a Bool. But clearly we can't combine the two into a single 949match. 950 951Conclusion: we can combine when we invoke PRead /at the same type/. Hence 952in PgSyn we record the instantiaing types, and use them in sameGroup. 953 954Note [Take care with pattern order] 955~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 956In the subGroup function we must be very careful about pattern re-ordering, 957Consider the patterns [ (True, Nothing), (False, x), (True, y) ] 958Then in bringing together the patterns for True, we must not 959swap the Nothing and y! 960-} 961 962sameGroup :: PatGroup -> PatGroup -> Bool 963-- Same group means that a single case expression 964-- or test will suffice to match both, *and* the order 965-- of testing within the group is insignificant. 966sameGroup PgAny PgAny = True 967sameGroup PgBang PgBang = True 968sameGroup (PgCon _) (PgCon _) = True -- One case expression 969sameGroup (PgSyn p1 t1) (PgSyn p2 t2) = p1==p2 && eqTypes t1 t2 970 -- eqTypes: See Note [Pattern synonym groups] 971sameGroup (PgLit _) (PgLit _) = True -- One case expression 972sameGroup (PgN l1) (PgN l2) = l1==l2 -- Order is significant 973sameGroup (PgOverS s1) (PgOverS s2) = s1==s2 974sameGroup (PgNpK l1) (PgNpK l2) = l1==l2 -- See Note [Grouping overloaded literal patterns] 975sameGroup (PgCo t1) (PgCo t2) = t1 `eqType` t2 976 -- CoPats are in the same goup only if the type of the 977 -- enclosed pattern is the same. The patterns outside the CoPat 978 -- always have the same type, so this boils down to saying that 979 -- the two coercions are identical. 980sameGroup (PgView e1 t1) (PgView e2 t2) = viewLExprEq (e1,t1) (e2,t2) 981 -- ViewPats are in the same group iff the expressions 982 -- are "equal"---conservatively, we use syntactic equality 983sameGroup _ _ = False 984 985-- An approximation of syntactic equality used for determining when view 986-- exprs are in the same group. 987-- This function can always safely return false; 988-- but doing so will result in the application of the view function being repeated. 989-- 990-- Currently: compare applications of literals and variables 991-- and anything else that we can do without involving other 992-- HsSyn types in the recursion 993-- 994-- NB we can't assume that the two view expressions have the same type. Consider 995-- f (e1 -> True) = ... 996-- f (e2 -> "hi") = ... 997viewLExprEq :: (LHsExpr GhcTc,Type) -> (LHsExpr GhcTc,Type) -> Bool 998viewLExprEq (e1,_) (e2,_) = lexp e1 e2 999 where 1000 lexp :: LHsExpr GhcTc -> LHsExpr GhcTc -> Bool 1001 lexp e e' = exp (unLoc e) (unLoc e') 1002 1003 --------- 1004 exp :: HsExpr GhcTc -> HsExpr GhcTc -> Bool 1005 -- real comparison is on HsExpr's 1006 -- strip parens 1007 exp (HsPar _ (dL->L _ e)) e' = exp e e' 1008 exp e (HsPar _ (dL->L _ e')) = exp e e' 1009 -- because the expressions do not necessarily have the same type, 1010 -- we have to compare the wrappers 1011 exp (HsWrap _ h e) (HsWrap _ h' e') = wrap h h' && exp e e' 1012 exp (HsVar _ i) (HsVar _ i') = i == i' 1013 exp (HsConLikeOut _ c) (HsConLikeOut _ c') = c == c' 1014 -- the instance for IPName derives using the id, so this works if the 1015 -- above does 1016 exp (HsIPVar _ i) (HsIPVar _ i') = i == i' 1017 exp (HsOverLabel _ l x) (HsOverLabel _ l' x') = l == l' && x == x' 1018 exp (HsOverLit _ l) (HsOverLit _ l') = 1019 -- Overloaded lits are equal if they have the same type 1020 -- and the data is the same. 1021 -- this is coarser than comparing the SyntaxExpr's in l and l', 1022 -- which resolve the overloading (e.g., fromInteger 1), 1023 -- because these expressions get written as a bunch of different variables 1024 -- (presumably to improve sharing) 1025 eqType (overLitType l) (overLitType l') && l == l' 1026 exp (HsApp _ e1 e2) (HsApp _ e1' e2') = lexp e1 e1' && lexp e2 e2' 1027 -- the fixities have been straightened out by now, so it's safe 1028 -- to ignore them? 1029 exp (OpApp _ l o ri) (OpApp _ l' o' ri') = 1030 lexp l l' && lexp o o' && lexp ri ri' 1031 exp (NegApp _ e n) (NegApp _ e' n') = lexp e e' && syn_exp n n' 1032 exp (SectionL _ e1 e2) (SectionL _ e1' e2') = 1033 lexp e1 e1' && lexp e2 e2' 1034 exp (SectionR _ e1 e2) (SectionR _ e1' e2') = 1035 lexp e1 e1' && lexp e2 e2' 1036 exp (ExplicitTuple _ es1 _) (ExplicitTuple _ es2 _) = 1037 eq_list tup_arg es1 es2 1038 exp (ExplicitSum _ _ _ e) (ExplicitSum _ _ _ e') = lexp e e' 1039 exp (HsIf _ _ e e1 e2) (HsIf _ _ e' e1' e2') = 1040 lexp e e' && lexp e1 e1' && lexp e2 e2' 1041 1042 -- Enhancement: could implement equality for more expressions 1043 -- if it seems useful 1044 -- But no need for HsLit, ExplicitList, ExplicitTuple, 1045 -- because they cannot be functions 1046 exp _ _ = False 1047 1048 --------- 1049 syn_exp :: SyntaxExpr GhcTc -> SyntaxExpr GhcTc -> Bool 1050 syn_exp (SyntaxExpr { syn_expr = expr1 1051 , syn_arg_wraps = arg_wraps1 1052 , syn_res_wrap = res_wrap1 }) 1053 (SyntaxExpr { syn_expr = expr2 1054 , syn_arg_wraps = arg_wraps2 1055 , syn_res_wrap = res_wrap2 }) 1056 = exp expr1 expr2 && 1057 and (zipWithEqual "viewLExprEq" wrap arg_wraps1 arg_wraps2) && 1058 wrap res_wrap1 res_wrap2 1059 1060 --------- 1061 tup_arg (dL->L _ (Present _ e1)) (dL->L _ (Present _ e2)) = lexp e1 e2 1062 tup_arg (dL->L _ (Missing t1)) (dL->L _ (Missing t2)) = eqType t1 t2 1063 tup_arg _ _ = False 1064 1065 --------- 1066 wrap :: HsWrapper -> HsWrapper -> Bool 1067 -- Conservative, in that it demands that wrappers be 1068 -- syntactically identical and doesn't look under binders 1069 -- 1070 -- Coarser notions of equality are possible 1071 -- (e.g., reassociating compositions, 1072 -- equating different ways of writing a coercion) 1073 wrap WpHole WpHole = True 1074 wrap (WpCompose w1 w2) (WpCompose w1' w2') = wrap w1 w1' && wrap w2 w2' 1075 wrap (WpFun w1 w2 _ _) (WpFun w1' w2' _ _) = wrap w1 w1' && wrap w2 w2' 1076 wrap (WpCast co) (WpCast co') = co `eqCoercion` co' 1077 wrap (WpEvApp et1) (WpEvApp et2) = et1 `ev_term` et2 1078 wrap (WpTyApp t) (WpTyApp t') = eqType t t' 1079 -- Enhancement: could implement equality for more wrappers 1080 -- if it seems useful (lams and lets) 1081 wrap _ _ = False 1082 1083 --------- 1084 ev_term :: EvTerm -> EvTerm -> Bool 1085 ev_term (EvExpr (Var a)) (EvExpr (Var b)) = a==b 1086 ev_term (EvExpr (Coercion a)) (EvExpr (Coercion b)) = a `eqCoercion` b 1087 ev_term _ _ = False 1088 1089 --------- 1090 eq_list :: (a->a->Bool) -> [a] -> [a] -> Bool 1091 eq_list _ [] [] = True 1092 eq_list _ [] (_:_) = False 1093 eq_list _ (_:_) [] = False 1094 eq_list eq (x:xs) (y:ys) = eq x y && eq_list eq xs ys 1095 1096patGroup :: DynFlags -> Pat GhcTc -> PatGroup 1097patGroup _ (ConPatOut { pat_con = (dL->L _ con) 1098 , pat_arg_tys = tys }) 1099 | RealDataCon dcon <- con = PgCon dcon 1100 | PatSynCon psyn <- con = PgSyn psyn tys 1101patGroup _ (WildPat {}) = PgAny 1102patGroup _ (BangPat {}) = PgBang 1103patGroup _ (NPat _ (dL->L _ (OverLit {ol_val=oval})) mb_neg _) = 1104 case (oval, isJust mb_neg) of 1105 (HsIntegral i, False) -> PgN (fromInteger (il_value i)) 1106 (HsIntegral i, True ) -> PgN (-fromInteger (il_value i)) 1107 (HsFractional r, False) -> PgN (fl_value r) 1108 (HsFractional r, True ) -> PgN (-fl_value r) 1109 (HsIsString _ s, _) -> ASSERT(isNothing mb_neg) 1110 PgOverS s 1111patGroup _ (NPlusKPat _ _ (dL->L _ (OverLit {ol_val=oval})) _ _ _) = 1112 case oval of 1113 HsIntegral i -> PgNpK (il_value i) 1114 _ -> pprPanic "patGroup NPlusKPat" (ppr oval) 1115patGroup _ (CoPat _ _ p _) = PgCo (hsPatType p) 1116 -- Type of innelexp pattern 1117patGroup _ (ViewPat _ expr p) = PgView expr (hsPatType (unLoc p)) 1118patGroup _ (ListPat (ListPatTc _ (Just _)) _) = PgOverloadedList 1119patGroup dflags (LitPat _ lit) = PgLit (hsLitKey dflags lit) 1120patGroup _ pat = pprPanic "patGroup" (ppr pat) 1121 1122{- 1123Note [Grouping overloaded literal patterns] 1124~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1125WATCH OUT! Consider 1126 1127 f (n+1) = ... 1128 f (n+2) = ... 1129 f (n+1) = ... 1130 1131We can't group the first and third together, because the second may match 1132the same thing as the first. Same goes for *overloaded* literal patterns 1133 f 1 True = ... 1134 f 2 False = ... 1135 f 1 False = ... 1136If the first arg matches '1' but the second does not match 'True', we 1137cannot jump to the third equation! Because the same argument might 1138match '2'! 1139Hence we don't regard 1 and 2, or (n+1) and (n+2), as part of the same group. 1140-} 1141