[commit: ghc] wip/ttypeable: Guard rewritableTyVarsOfType (f03ebe3)

[git at git.haskell.org]

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

On branch  : wip/ttypeable
Link       : http://ghc.haskell.org/trac/ghc/changeset/f03ebe3ac6a5de5038a431d0a1e527354b339cd2/ghc

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

commit f03ebe3ac6a5de5038a431d0a1e527354b339cd2
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Feb 9 12:12:21 2017 +0000

    Guard rewritableTyVarsOfType
    
    We only want to use rewriteableTyVarsOfType on CDictCan,
    CFunEqCan (and maybe CIrredCan).  But not CTyEqCan.
    
    But we were -- for insolubles.  So I narrowed the scope of
    the insuluble kick-out.


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

f03ebe3ac6a5de5038a431d0a1e527354b339cd2
 compiler/typecheck/TcSMonad.hs | 25 +++++++++++++------------
 compiler/typecheck/TcType.hs   |  2 ++
 2 files changed, 15 insertions(+), 12 deletions(-)

diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs
index 6f53f07..00dcd06 100644
--- a/compiler/typecheck/TcSMonad.hs
+++ b/compiler/typecheck/TcSMonad.hs
@@ -1495,24 +1495,25 @@ kick_out_rewritable new_fr new_tv ics@(IC { inert_eqs      = tv_eqs
            -- See Note [Kicking out CFunEqCan for fundeps]
     (dicts_out,  dicts_in)  = partitionDicts   kick_out_ct dictmap
     (irs_out,    irs_in)    = partitionBag     kick_out_ct irreds
-    (insols_out, insols_in) = partitionBag     kick_out_ct insols
-      -- Kick out even insolubles; see Note [Kick out insolubles]
+    (insols_out, insols_in) = partitionBag     kick_out_insol insols
 
     fr_may_rewrite :: CtFlavourRole -> Bool
     fr_may_rewrite fs = new_fr `eqMayRewriteFR` fs
         -- Can the new item rewrite the inert item?
 
+    kick_out_insol :: Ct -> Bool
+      -- See Note [Kick out insolubles]
+    kick_out_insol (CTyEqCan { cc_tyvar = tv }) = new_tv == tv
+    kick_out_insol _                            = False
+
     kick_out_ct :: Ct -> Bool
-    -- Kick it out if the new CTyEqCan can rewrite the inert
-    -- one. See Note [kickOutRewritable]
-    -- Or if it has no shadow and the shadow
-    kick_out_ct ct = kick_out_ev (ctEvidence ct)
-
-    kick_out_ev :: CtEvidence -> Bool
-    -- Kick it out if the new CTyEqCan can rewrite the inert
-    -- one. See Note [kickOutRewritable]
-    kick_out_ev ev = fr_may_rewrite (ctEvFlavourRole ev)
-                  && new_tv `elemVarSet` rewritableTyVarsOfType (ctEvPred ev)
+    -- Kick it out if the new CTyEqCan can rewrite the inert one
+    -- See Note [kickOutRewritable]
+    -- Used only on CFunEqCan, CDictCan, CIrredCan
+    --   hence no forallls in (ctEvPred ev), hence rewriteableTyVarsOfType ok
+    kick_out_ct ct | let ev = ctEvidence ct
+                   = fr_may_rewrite (ctEvFlavourRole ev)
+                   && new_tv `elemVarSet` rewritableTyVarsOfType (ctEvPred ev)
                   -- NB: this includes the fsk of a CFunEqCan.  It can't
                   --     actually be rewritten, but we need to kick it out
                   --     so we get to take advantage of injectivity
diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs
index 146de37..f19ff10 100644
--- a/compiler/typecheck/TcType.hs
+++ b/compiler/typecheck/TcType.hs
@@ -892,6 +892,8 @@ rewritableTyVarsOfTypes tys = mapUnionVarSet rewritableTyVarsOfType tys
 
 rewritableTyVarsOfType :: HasCallStack => TcType -> TcTyVarSet
 -- Used during kick-out from the inert set
+-- This function is used for the arguments of class and type families,
+--    which should not have any foralls in them
 -- Ignores coercions and casts, because rewriting those does
 -- not help solving, and it's more efficient to ignore them
 rewritableTyVarsOfType ty