[commit: ghc] master: Add a fast-path in TcInteract.kickOutRewritable (7381cee)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/7381cee923526535dfc9e9599e47f61390a51305/ghc

>---------------------------------------------------------------

commit 7381cee923526535dfc9e9599e47f61390a51305
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Jul 31 13:49:32 2014 +0100

    Add a fast-path in TcInteract.kickOutRewritable


>---------------------------------------------------------------

7381cee923526535dfc9e9599e47f61390a51305
 compiler/typecheck/TcInteract.lhs | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs
index 2590d35..33249f4 100644
--- a/compiler/typecheck/TcInteract.lhs
+++ b/compiler/typecheck/TcInteract.lhs
@@ -753,12 +753,16 @@ kickOutRewritable :: CtEvidence   -- Flavour of the equality that is
                   -> InertCans
                   -> TcS (Int, InertCans)
 kickOutRewritable new_ev new_tv
-                  (IC { inert_eqs = tv_eqs
-                      , inert_dicts  = dictmap
-                      , inert_funeqs = funeqmap
-                      , inert_irreds = irreds
-                      , inert_insols = insols
-                      , inert_no_eqs = no_eqs })
+                  inert_cans@(IC { inert_eqs = tv_eqs
+                                 , inert_dicts  = dictmap
+                                 , inert_funeqs = funeqmap
+                                 , inert_irreds = irreds
+                                 , inert_insols = insols
+                                 , inert_no_eqs = no_eqs })
+  | new_tv `elemVarEnv` tv_eqs   -- Fast path: there is at least one equality for tv
+                                 -- so kick-out will do nothing
+  = return (0, inert_cans)
+  | otherwise
   = do { traceTcS "kickOutRewritable" $
             vcat [ text "tv = " <+> ppr new_tv
                  , ptext (sLit "Kicked out =") <+> ppr kicked_out]