Fix a serious bug in roughMatchTcs

The roughMatchTcs function enables a quick definitely-no-match test
in lookupInstEnv.  Unfortunately, it didn't account for type families.
This didn't matter when type families were flattened away, but now
they aren't flattened it matters a lot.

The fix is very easy. See INVARIANT in GHC.Core.InstEnv
Note [ClsInst laziness and the rough-match fields]

Fixes #19336

The change makes compiler perf worse on two very-type-family-heavy
benchmarks, T9872{a,d}:
  T9872a(normal) ghc/alloc  2172536442.7  2216337648.0  +2.0%
  T9872d(normal) ghc/alloc   614584024.0   621081384.0  +1.1%
(Everything else is 0.0% or at most 0.1%.)

I think we just have to put up with this. Some cases were being
wrongly filtered out by roughMatchTcs that might actually match, which
could lead to false apartness checks.  And it only affects these very
type-family-heavy cases.

Metric Increase:
    T9872a
    T9872d

3 files changed, 48 insertions, 0 deletions

diff --git a/testsuite/tests/indexed-types/should_compile/T19336.hs b/testsuite/tests/indexed-types/should_compile/T19336.hs
new file mode 100644
index 0000000000..dfc7409fa3
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T19336.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances
+           , DataKinds, NoMonomorphismRestriction, UndecidableInstances
+           , TypeFamilies #-}
+
+{-# OPTIONS_GHC -Wall #-}
+
+module T19336 where
+
+import GHC.TypeLits
+
+class X a b where
+  convert :: a -> b
+
+instance X Int String where
+  convert = show
+
+instance X String String where
+  convert = id
+
+instance {-# OVERLAPPABLE #-} TypeError ('Text "Oops") => X a b where
+  convert = error "unreachable"
+
+type family F a where
+  F String = String
+  F Int    = String
+
+convert_f :: X a (F a) => a -> a -> F a
+convert_f _ = convert
+
+----------
+
+class Poly a where
+  poly :: a
+
+instance Poly String where
+  poly = "hi"
+
+instance Poly Int where
+  poly = 2
+
+----------
+
+oops = convert_f poly
diff --git a/testsuite/tests/indexed-types/should_compile/T19336.stderr b/testsuite/tests/indexed-types/should_compile/T19336.stderr
new file mode 100644
index 0000000000..f841f79628
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T19336.stderr
@@ -0,0 +1,4 @@
+
+T19336.hs:43:1: warning: [-Wmissing-signatures (in -Wall)]
+    Top-level binding with no type signature:
+      oops :: (X a (F a), Poly a) => a -> F a
diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T
index 469dd915df..7d8aa9f3ae 100644
--- a/testsuite/tests/indexed-types/should_compile/all.T
+++ b/testsuite/tests/indexed-types/should_compile/all.T
@@ -302,3 +302,4 @@ test('GivenLoop', normal, compile, [''])
 test('T18875', normal, compile, [''])
 test('T8707', normal, compile, ['-O'])
 test('T14111', normal, compile, ['-O'])
+test('T19336', normal, compile, ['-O'])