update tests

16 files changed, 181 insertions, 75 deletions

diff --git a/compiler/GHC/Core/FamInstEnv.hs b/compiler/GHC/Core/FamInstEnv.hs
index 04c1b3add4..52a398b5be 100644
--- a/compiler/GHC/Core/FamInstEnv.hs
+++ b/compiler/GHC/Core/FamInstEnv.hs
@@ -991,14 +991,14 @@ lookup_fam_inst_env'          -- The worker, local to this module
     -> [FamInstMatch]
 lookup_fam_inst_env' match_fun (FamIE _ ie) fam match_tys
   | isOpenFamilyTyCon fam
-  , let xs = lookupRM' rough_tmpl ie   -- The common case
+  , let (xs, _) = lookupRM' rough_tmpl ie   -- The common case
     -- Avoid doing any of the allocation below if there are no instances to look at.
   , not $ null xs
   = mapMaybe' f xs
   | otherwise = []
   where
     rough_tmpl :: [RoughMatchLookupTc]
-    rough_tmpl = LookupKnownTc (tyConName fam) : map typeToRoughMatchLookupTc match_tys
+    rough_tmpl = LookupKnownTc (tyConName fam) : map (roughMatchTcToLookup . typeToRoughMatchTc) match_tys
 
     f :: FamInst -> Maybe FamInstMatch
     f item@(FamInst { fi_tcs = mb_tcs, fi_tvs = tpl_tvs, fi_cvs = tpl_cvs
diff --git a/compiler/GHC/Core/InstEnv.hs b/compiler/GHC/Core/InstEnv.hs
index 13eb0c024a..210907e150 100644
--- a/compiler/GHC/Core/InstEnv.hs
+++ b/compiler/GHC/Core/InstEnv.hs
@@ -11,6 +11,7 @@ The bits common to GHC.Tc.TyCl.Instance and GHC.Tc.Deriv.
 
 module GHC.Core.InstEnv (
         DFunId, InstMatch, ClsInstLookupResult,
+        PotentialUnifiers(..), getPotentialUnifiers, nullUnifiers,
         OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,
         ClsInst(..), DFunInstType, pprInstance, pprInstanceHdr, pprInstances,
         instanceHead, instanceSig, mkLocalInstance, mkImportedInstance,
@@ -55,6 +56,9 @@ import Data.Maybe       ( isJust )
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Utils.Misc
+import GHC.Driver.Ppr
+import GHC.Data.Bag
+import Data.Semigroup
 
 {-
 ************************************************************************
@@ -463,7 +467,7 @@ classInstances (InstEnvs { ie_global = pkg_ie, ie_local = home_ie, ie_visible =
 -- We use this when we do signature checking in "GHC.Tc.Module"
 memberInstEnv :: InstEnv -> ClsInst -> Bool
 memberInstEnv (InstEnv rm) ins_item@(ClsInst { is_tcs = tcs } ) =
-    any (identicalDFunType ins_item) (lookupRM' (map roughMatchTcToLookup tcs) rm)
+    any (identicalDFunType ins_item) (fst $ lookupRM' (map roughMatchTcToLookup tcs) rm)
  where
   identicalDFunType cls1 cls2 =
     eqType (varType (is_dfun cls1)) (varType (is_dfun cls2))
@@ -745,7 +749,7 @@ type InstMatch = (ClsInst, [DFunInstType])
 
 type ClsInstLookupResult
      = ( [InstMatch]     -- Successful matches
-       , [ClsInst]       -- These don't match but do unify
+       , PotentialUnifiers  -- These don't match but do unify
        , [InstMatch] )   -- Unsafe overlapped instances under Safe Haskell
                          -- (see Note [Safe Haskell Overlapping Instances] in
                          -- GHC.Tc.Solver).
@@ -826,11 +830,34 @@ lookupUniqueInstEnv instEnv cls tys
       _other -> Left $ text "instance not found" <+>
                        (ppr $ mkTyConApp (classTyCon cls) tys)
 
+data PotentialUnifiers = NoUnifiers | OneUnifier ClsInst | TwoOrMoreUnifiers [ClsInst] -- LAZY!!
+
+instance Outputable PotentialUnifiers where
+  ppr NoUnifiers = text "NoUnifiers"
+  ppr xs = ppr (getPotentialUnifiers xs)
+
+instance Semigroup PotentialUnifiers where
+  NoUnifiers <> u = u
+  u <> NoUnifiers = u
+  u1 <> u2 = TwoOrMoreUnifiers (getPotentialUnifiers u1 ++ getPotentialUnifiers u2)
+
+instance Monoid PotentialUnifiers where
+  mempty = NoUnifiers
+
+getPotentialUnifiers :: PotentialUnifiers -> [ClsInst]
+getPotentialUnifiers NoUnifiers = []
+getPotentialUnifiers (OneUnifier item) = [item]
+getPotentialUnifiers (TwoOrMoreUnifiers cls) = cls
+
+nullUnifiers :: PotentialUnifiers -> Bool
+nullUnifiers NoUnifiers = True
+nullUnifiers _ = False
+
 lookupInstEnv' :: InstEnv          -- InstEnv to look in
                -> VisibleOrphanModules   -- But filter against this
                -> Class -> [Type]  -- What we are looking for
                -> ([InstMatch],    -- Successful matches
-                   [ClsInst])      -- These don't match but do unify
+                   PotentialUnifiers)      -- These don't match but do unify
                                    -- (no incoherent ones in here)
 -- The second component of the result pair happens when we look up
 --      Foo [a]
@@ -843,25 +870,38 @@ lookupInstEnv' :: InstEnv          -- InstEnv to look in
 -- giving a suitable error message
 
 lookupInstEnv' (InstEnv rm) vis_mods cls tys
-  = foldl' f ([], []) rough_matches
+  = pprTrace "lookupInstEnv'" (ppr cls <+> ppr (length rough_matches) <+> ppr tys <+> ppr rough_tcs)
+
+ -- pprTraceIt "lookupInstEnv'"
+  (foldr check_match [] rough_matches, check_unifier NoUnifiers (bagToList rough_unifiers))
   where
-    rough_matches = (lookupRM' rough_tcs rm)
+    (rough_matches, rough_unifiers) = lookupRM' rough_tcs rm
     rough_tcs  = LookupKnownTc (className cls) : roughMatchTcsLookup tys
 
     --------------
-    f :: ([InstMatch], [ClsInst]) -> ClsInst -> ([InstMatch], [ClsInst])
-    f acc@(ms, us) item@(ClsInst { is_tvs = tpl_tvs, is_tys = tpl_tys })
+    check_match :: ClsInst -> [InstMatch] -> [InstMatch]
+    check_match item@(ClsInst { is_tvs = tpl_tvs, is_tys = tpl_tys }) acc
       | not (instIsVisible vis_mods item)
       = acc  -- See Note [Instance lookup and orphan instances]
 
       | Just subst <- tcMatchTys tpl_tys tys
-      = ((item, map (lookupTyVar subst) tpl_tvs) : ms, us)
+      = ((item, map (lookupTyVar subst) tpl_tvs) : acc)
+      | otherwise
+      = acc
+      where
+        tpl_tv_set = mkVarSet tpl_tvs
+        tys_tv_set = tyCoVarsOfTypes tys
 
+
+    check_unifier :: PotentialUnifiers -> [ClsInst] -> PotentialUnifiers
+    check_unifier acc [] = acc
+    check_unifier acc (item@ClsInst { is_tvs = tpl_tvs, is_tys = tpl_tys }:items)
+      | [_] <- check_match item [] = check_unifier acc items
         -- Does not match, so next check whether the things unify
         -- See Note [Overlapping instances]
         -- Ignore ones that are incoherent: Note [Incoherent instances]
       | isIncoherent item
-      = acc
+      = check_unifier acc items
 
       | otherwise
       = ASSERT2( tys_tv_set `disjointVarSet` tpl_tv_set,
@@ -875,10 +915,16 @@ lookupInstEnv' (InstEnv rm) vis_mods cls tys
           -- We consider MaybeApart to be a case where the instance might
           -- apply in the future. This covers an instance like C Int and
           -- a target like [W] C (F a), where F is a type family.
-            SurelyApart              -> acc
+            SurelyApart              -> check_unifier acc items
               -- Note [Infinitary substitution in lookup]
-            MaybeApart MARInfinite _ -> acc
-            _                        -> (ms, item:us)
+            MaybeApart MARInfinite _ -> check_unifier acc items
+            _                        ->
+              case acc of
+                NoUnifiers -> check_unifier (OneUnifier item) items
+                OneUnifier cls ->
+                  TwoOrMoreUnifiers (cls:item:
+                    (getPotentialUnifiers $ check_unifier NoUnifiers items))
+
       where
         tpl_tv_set = mkVarSet tpl_tvs
         tys_tv_set = tyCoVarsOfTypes tys
@@ -903,7 +949,7 @@ lookupInstEnv check_overlap_safe
     (home_matches, home_unifs) = lookupInstEnv' home_ie vis_mods cls tys
     (pkg_matches,  pkg_unifs)  = lookupInstEnv' pkg_ie  vis_mods cls tys
     all_matches = home_matches ++ pkg_matches
-    all_unifs   = home_unifs   ++ pkg_unifs
+    all_unifs   = home_unifs   `mappend` pkg_unifs
     final_matches = foldr insert_overlapping [] all_matches
         -- Even if the unifs is non-empty (an error situation)
         -- we still prune the matches, so that the error message isn't
@@ -917,7 +963,7 @@ lookupInstEnv check_overlap_safe
 
     -- If the selected match is incoherent, discard all unifiers
     final_unifs = case final_matches of
-                    (m:_) | isIncoherent (fst m) -> []
+                    (m:_) | isIncoherent (fst m) -> NoUnifiers
                     _                            -> all_unifs
 
     -- NOTE [Safe Haskell isSafeOverlap]
diff --git a/compiler/GHC/Core/RoughMap.hs b/compiler/GHC/Core/RoughMap.hs
index 77618b0e64..aabf3469a2 100644
--- a/compiler/GHC/Core/RoughMap.hs
+++ b/compiler/GHC/Core/RoughMap.hs
@@ -42,6 +42,8 @@ import {-# SOURCE #-} GHC.Tc.Utils.TcType
 import Control.Monad (join)
 import Data.Data (Data)
 import GHC.Types.Var.Set
+import GHC.Utils.Misc
+import Data.Bifunctor
 
 {-
 Note [Rough maps of Types]
@@ -81,7 +83,6 @@ isRoughOtherTc :: RoughMatchTc -> Bool
 isRoughOtherTc OtherTc      = True
 isRoughOtherTc (KnownTc {}) = False
 
-
 typeToRoughMatchLookupTc :: Type -> RoughMatchLookupTc
 typeToRoughMatchLookupTc ty
   | Just (ty', _) <- splitCastTy_maybe ty   = typeToRoughMatchLookupTc ty'
@@ -125,29 +126,40 @@ emptyRM = RMEmpty
 
 -- | Order of result is deterministic.
 lookupRM :: [RoughMatchLookupTc] -> RoughMap a -> [a]
-lookupRM tcs rm = bagToList (lookupRM' tcs rm)
+lookupRM tcs rm = bagToList (fst $ lookupRM' tcs rm)
+
 
 -- | N.B. Returns a 'Bag', which allows us to avoid rebuilding all of the lists
 -- we find in 'rm_empty', which would otherwise be necessary due to '++' if we
 -- returned a list.
-lookupRM' :: [RoughMatchLookupTc] -> RoughMap a -> Bag a
-lookupRM' _                  RMEmpty = emptyBag
-lookupRM' []                 rm      = listToBag $ elemsRM rm
-lookupRM' (LookupKnownTc tc : tcs) rm  = foldl' unionBags emptyBag
-                                       [ maybe emptyBag (lookupRM' tcs) (lookupDNameEnv (rm_known rm) tc)
-                                       , lookupRM' tcs (rm_unknown rm)
-                                       , rm_empty rm
-                                       ]
--- A SkolemTC does **not** match any KnownTC
-lookupRM' (NoKnownTc : tcs)  rm      = foldl' unionBags emptyBag
-                                       [ lookupRM' tcs (rm_unknown rm)
-                                       , rm_empty rm ]
-
-lookupRM' (LookupOtherTc : tcs)    rm  = foldl' unionBags emptyBag
-                                       [ foldl' unionBags emptyBag $ map (lookupRM' tcs) (eltsDNameEnv $ rm_known rm)
-                                       , lookupRM' tcs (rm_unknown rm)
-                                       , rm_empty rm
-                                       ]
+lookupRM' :: [RoughMatchLookupTc] -> RoughMap a -> (Bag a -- Potential matches
+                                                   , Bag a) -- Potential unifiers
+lookupRM' _                  RMEmpty = (emptyBag, emptyBag)
+lookupRM' []                 rm      = let m = listToBag $ elemsRM rm
+                                       in (m, m)
+lookupRM' (LookupKnownTc tc : tcs) rm  =
+  let (common_m, common_u) = lookupRM' tcs (rm_unknown rm)
+      (m, u) = maybe (emptyBag, emptyBag) (lookupRM' tcs) (lookupDNameEnv (rm_known rm) tc)
+  in (rm_empty rm `unionBags` common_m `unionBags` m , rm_empty rm `unionBags` common_u `unionBags` u)
+-- A SkolemTC does **not** match any KnownTC but can unify
+lookupRM' (NoKnownTc : tcs)  rm      =
+
+  let (u_m, _u_u) = lookupRM' tcs (rm_unknown rm)
+      empty = rm_empty rm
+  in (u_m `unionBags` empty -- Definitely don't match
+     , snd $ lookupRM' (LookupOtherTc : tcs) rm) -- But could unify..
+
+lookupRM' (LookupOtherTc : tcs)    rm  =
+  let (m, u) = bimap unionManyBags unionManyBags (mapAndUnzip (lookupRM' tcs) (eltsDNameEnv $ rm_known rm))
+      (u_m, u_u) = lookupRM' tcs (rm_unknown rm)
+  in (rm_empty rm `unionBags` u_m `unionBags` m
+     , rm_empty rm `unionBags` u_u `unionBags` u)
+
+{-
+  let m = foldl' unionBags emptyBag
+           [
+           , rm_empty rm ] in (m, m)
+           -}
 
 unionRM :: RoughMap a -> RoughMap a -> RoughMap a
 unionRM RMEmpty a = a
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index 665df1398d..db760ecd65 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -2344,7 +2344,7 @@ mkDictErr ctxt cts
     is_no_inst (ct, (matches, unifiers, _))
       =  no_givens
       && null matches
-      && (null unifiers || all (not . isAmbiguousTyVar) (tyCoVarsOfCtList ct))
+      && (nullUnifiers unifiers || all (not . isAmbiguousTyVar) (tyCoVarsOfCtList ct))
 
     lookup_cls_inst inst_envs ct
                 -- Note [Flattening in error message generation]
@@ -2409,7 +2409,7 @@ mk_dict_err ctxt@(CEC {cec_encl = implics}) (ct, (matches, unifiers, unsafe_over
              , nest 2 extra_note
              , vcat (pp_givens useful_givens)
              , mb_patsyn_prov `orElse` empty
-             , ppWhen (has_ambig_tvs && not (null unifiers && null useful_givens))
+             , ppWhen (has_ambig_tvs && not (nullUnifiers unifiers && null useful_givens))
                (vcat [ ppUnless lead_with_ambig ambig_msg, binds_msg, potential_msg ])
 
              , ppWhen (isNothing mb_patsyn_prov) $
@@ -2425,7 +2425,7 @@ mk_dict_err ctxt@(CEC {cec_encl = implics}) (ct, (matches, unifiers, unsafe_over
         orig = ctOrigin ct
         -- See Note [Highlighting ambiguous type variables]
         lead_with_ambig = has_ambig_tvs && not (any isRuntimeUnkSkol ambig_tvs)
-                        && not (null unifiers) && null useful_givens
+                        && not (nullUnifiers unifiers) && null useful_givens
 
         (has_ambig_tvs, ambig_msg) = mkAmbigMsg lead_with_ambig ct
         ambig_tvs = uncurry (++) (getAmbigTkvs ct)
@@ -2445,16 +2445,16 @@ mk_dict_err ctxt@(CEC {cec_encl = implics}) (ct, (matches, unifiers, unsafe_over
             <+> pprParendType pred
 
         potential_msg
-          = ppWhen (not (null unifiers) && want_potential orig) $
+          = ppWhen (not (nullUnifiers unifiers) && want_potential orig) $
             sdocOption sdocPrintPotentialInstances $ \print_insts ->
             getPprStyle $ \sty ->
-            pprPotentials (PrintPotentialInstances print_insts) sty potential_hdr unifiers
+            pprPotentials (PrintPotentialInstances print_insts) sty potential_hdr (getPotentialUnifiers unifiers)
 
         potential_hdr
           = vcat [ ppWhen lead_with_ambig $
                      text "Probable fix: use a type annotation to specify what"
                      <+> pprQuotedList ambig_tvs <+> text "should be."
-                 , text "These potential instance" <> plural unifiers
+                 , text "These potential instance" <> plural (getPotentialUnifiers unifiers)
                    <+> text "exist:"]
 
         mb_patsyn_prov :: Maybe SDoc
@@ -2510,9 +2510,9 @@ mk_dict_err ctxt@(CEC {cec_encl = implics}) (ct, (matches, unifiers, unsafe_over
              ,  sdocOption sdocPrintPotentialInstances $ \print_insts ->
                 getPprStyle $ \sty ->
                 pprPotentials (PrintPotentialInstances print_insts) sty (text "Matching instances:") $
-                ispecs ++ unifiers
+                ispecs ++ (getPotentialUnifiers unifiers)
 
-             ,  ppWhen (null matching_givens && isSingleton matches && null unifiers) $
+             ,  ppWhen (null matching_givens && isSingleton matches && nullUnifiers unifiers) $
                 -- Intuitively, some given matched the wanted in their
                 -- flattened or rewritten (from given equalities) form
                 -- but the matcher can't figure that out because the
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index 63b8ea4b8b..4bf78f61cd 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -1643,7 +1643,7 @@ reifyInstances' th_nm th_tys
                -> do { inst_envs <- tcGetInstEnvs
                      ; let (matches, unifies, _) = lookupInstEnv False inst_envs cls tys
                      ; traceTc "reifyInstances'1" (ppr matches)
-                     ; return $ Left (cls, map fst matches ++ unifies) }
+                     ; return $ Left (cls, map fst matches ++ getPotentialUnifiers unifies) }
                | isOpenFamilyTyCon tc
                -> do { inst_envs <- tcGetFamInstEnvs
                      ; let matches = lookupFamInstEnv inst_envs tc tys
diff --git a/compiler/GHC/Tc/Instance/Class.hs b/compiler/GHC/Tc/Instance/Class.hs
index 84b523eb93..10745ec4ac 100644
--- a/compiler/GHC/Tc/Instance/Class.hs
+++ b/compiler/GHC/Tc/Instance/Class.hs
@@ -174,12 +174,12 @@ matchInstEnv dflags short_cut_solver clas tys
         ; case (matches, unify, safeHaskFail) of
 
             -- Nothing matches
-            ([], [], _)
+            ([], NoUnifiers, _)
                 -> do { traceTc "matchClass not matching" (ppr pred)
                       ; return NoInstance }
 
             -- A single match (& no safe haskell failure)
-            ([(ispec, inst_tys)], [], False)
+            ([(ispec, inst_tys)], NoUnifiers, False)
                 | short_cut_solver      -- Called from the short-cut solver
                 , isOverlappable ispec
                 -- If the instance has OVERLAPPABLE or OVERLAPS or INCOHERENT
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index d016641f2d..6464595ba1 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -1714,7 +1714,7 @@ tcMissingParentClassWarn warnFlag isName shouldName
                            hsep [ text "This will become an error in"
                                 , text "a future release." ]
                  warnMsg _ = pure ()
-           ; when (null shouldInsts && null instanceMatches) $
+           ; when (nullUnifiers shouldInsts && null instanceMatches) $
                   warnMsg (is_tcs isInst)
            }
 
diff --git a/testsuite/tests/backpack/should_fail/bkpfail28.stderr b/testsuite/tests/backpack/should_fail/bkpfail28.stderr
index ef8d72cfe3..e7831ce197 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail28.stderr
+++ b/testsuite/tests/backpack/should_fail/bkpfail28.stderr
@@ -9,19 +9,19 @@
 bkpfail28.bkp:19:13: error:
     • Overlapping instances for Show (K a) arising from a use of ‘show’
       Matching instances:
-        instance [safe] Show a => Show (K a)
-          -- Defined at bkpfail28.bkp:12:18
         instance [safe] Read a => Show (K a)
           -- Defined at bkpfail28.bkp:12:18
+        instance [safe] Show a => Show (K a)
+          -- Defined at bkpfail28.bkp:12:18
     • In the expression: show
       In an equation for ‘f’: f = show
 
 bkpfail28.bkp:21:13: error:
     • Overlapping instances for Show (K a) arising from a use of ‘show’
       Matching instances:
-        instance [safe] Show a => Show (K a)
-          -- Defined at bkpfail28.bkp:12:18
         instance [safe] Read a => Show (K a)
           -- Defined at bkpfail28.bkp:12:18
+        instance [safe] Show a => Show (K a)
+          -- Defined at bkpfail28.bkp:12:18
     • In the expression: show
       In an equation for ‘g’: g = show
diff --git a/testsuite/tests/ghci/scripts/ghci044.stderr b/testsuite/tests/ghci/scripts/ghci044.stderr
index 716f46e12e..668388dea8 100644
--- a/testsuite/tests/ghci/scripts/ghci044.stderr
+++ b/testsuite/tests/ghci/scripts/ghci044.stderr
@@ -2,7 +2,7 @@
 <interactive>:9:1: error:
     • Overlapping instances for C [Int] arising from a use of ‘f’
       Matching instances:
-        instance [safe] C [Int] -- Defined at <interactive>:6:10
         instance [safe] C a => C [a] -- Defined at <interactive>:8:10
+        instance [safe] C [Int] -- Defined at <interactive>:6:10
     • In the expression: f [4 :: Int]
       In an equation for ‘it’: it = f [4 :: Int]
diff --git a/testsuite/tests/ghci/scripts/ghci064.stdout b/testsuite/tests/ghci/scripts/ghci064.stdout
index 2d1bb17423..ad2d135b80 100644
--- a/testsuite/tests/ghci/scripts/ghci064.stdout
+++ b/testsuite/tests/ghci/scripts/ghci064.stdout
@@ -29,8 +29,8 @@ instance [safe] MyShow w => MyShow [w]
 instance GHC.Generics.Generic [T] -- Defined in ‘GHC.Generics’
 instance Monoid [T] -- Defined in ‘GHC.Base’
 instance Semigroup [T] -- Defined in ‘GHC.Base’
-instance [safe] MyShow [T] -- Defined at ghci064.hs:8:10
 instance [safe] MyShow [T] -- Defined at ghci064.hs:16:10
+instance [safe] MyShow [T] -- Defined at ghci064.hs:8:10
 instance GHC.Generics.SingKind Bool -- Defined in ‘GHC.Generics’
 instance Foreign.Storable.Storable Bool
   -- Defined in ‘Foreign.Storable’
diff --git a/testsuite/tests/perf/compiler/Makefile b/testsuite/tests/perf/compiler/Makefile
index 9afc74189c..be2adb00d7 100644
--- a/testsuite/tests/perf/compiler/Makefile
+++ b/testsuite/tests/perf/compiler/Makefile
@@ -13,6 +13,8 @@ T11068:
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c -O T11068b.hs
 	-'$(TEST_HC)' $(TEST_HC_OPTS) -c -O T11068.hs -ddump-simpl | grep 'Generic'
 
+# Type family skolems
 InstanceMatching:
-	./genMatchingTest
+	./genMatchingTest 0
 	'$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface Defs.hs
+
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 30b0c5dd50..1094121ef5 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -276,6 +276,7 @@ test('MultiLayerModules',
      multimod_compile,
      ['MultiLayerModules', '-v0'])
 
+# This test isolates the (F a[sk]) case
 test('InstanceMatching',
      [ collect_compiler_stats('bytes allocated',3),
        pre_cmd('$MAKE -s --no-print-directory InstanceMatching'),
@@ -290,6 +291,21 @@ test('InstanceMatching',
      multimod_compile_fail,
      ['Match', '-fno-code -fwrite-interface -v0'])
 
+# This module stresses the KnownTC and NoKnownTC (skolem variable) cases
+test('InstanceMatching1',
+     [ collect_compiler_stats('bytes allocated',3),
+       pre_cmd('./genMatchingTest 1'),
+       extra_files(['genMatchingTest']),
+       compile_timeout_multiplier(5)
+       # this is _a lot_
+       # but this test has been failing every now and then,
+       # especially on i386. Let's just give it some room
+       # to complete successfully reliably everywhere.
+     ],
+     multimod_compile,
+     ['Defs', '-fno-code -fwrite-interface -v0'])
+
+
 test('MultiLayerModulesNoCode',
      [ collect_compiler_residency(15),
        pre_cmd('./genMultiLayerModulesNoCode'),
diff --git a/testsuite/tests/perf/compiler/genMatchingTest b/testsuite/tests/perf/compiler/genMatchingTest
index a8b3e5f7fe..9356d9028a 100755
--- a/testsuite/tests/perf/compiler/genMatchingTest
+++ b/testsuite/tests/perf/compiler/genMatchingTest
@@ -2,21 +2,51 @@
 # Generate a module with N data types and instances
 DEFS=10000
 MATCHES=500
+MODE=$1
 echo "module Defs where" > Defs.hs;
 for i in $(seq -w 1 $DEFS); do
-  echo "data T$i = T$i deriving Show" >> Defs.hs;
+  echo "data T$i a = T$i a deriving Show" >> Defs.hs;
 done
 
 echo "{-# LANGUAGE TypeFamilies #-}" > Match.hs
 echo "{-# LANGUAGE StandaloneDeriving #-}" >> Match.hs
+echo "{-# LANGUAGE EmptyDataDecls #-}" >> Match.hs
 echo "module Match where" >> Match.hs
 echo "import Defs" >> Match.hs
-for i in $(seq -w 1 $MATCHES); do
-  echo "type family F$i a where" >> Match.hs;
-done
-echo "data T a = T" >> Match.hs
-for i in $(seq -w 1 $MATCHES); do
-  echo "       (F$i a)" >> Match.hs;
-done
-echo "deriving instance Show (T a)" >> Match.hs;
+
+if [ $MODE -eq 0 ]; then
+  for i in $(seq -w 1 $MATCHES); do
+    echo "type family F$i a where" >> Match.hs;
+  done
+  echo "data T a = T" >> Match.hs
+  for i in $(seq -w 1 $MATCHES); do
+    echo "       (F$i a)" >> Match.hs;
+  done
+  echo "deriving instance Show (T a)" >> Match.hs;
+fi
+#elif [ $MODE -eq 1 ]; then
+#  echo "data T " >> Match.hs
+#    for i in $(seq -w 1 $MATCHES); do
+#      echo "       a$i" >> Match.hs;
+#    done
+#    echo "       = T " >> Match.hs
+#    for i in $(seq -w 1 $MATCHES); do
+#      echo "       a$i" >> Match.hs;
+#    done
+#    echo "deriving instance Show (T" >> Match.hs
+#    for i in $(seq -w 1 $MATCHES); do
+#      echo "       a$i" >> Match.hs;
+#    done
+#    echo "    )" >> Match.hs;
+#else
+#  for i in $(seq -w 1 $MATCHES); do
+#    echo "data F$i a" >> Match.hs;
+#  done
+#  echo "data T a = T" >> Match.hs
+#  for i in $(seq -w 1 $MATCHES); do
+#    echo "       (F$i a)" >> Match.hs;
+#  done
+#  echo "deriving instance Show (T a)" >> Match.hs;
+#
+#fi
 
diff --git a/testsuite/tests/th/T11629.hs b/testsuite/tests/th/T11629.hs
index 4fcc093823..11373fd4cb 100644
--- a/testsuite/tests/th/T11629.hs
+++ b/testsuite/tests/th/T11629.hs
@@ -37,7 +37,7 @@ do
   ty1 <- [t| C True |]
   ty2 <- [t| C 'False |]
   ClassI _ insts <- reify ''C
-  let [ty1', ty2'] = map getType insts
+  let [ty2', ty1'] = map getType insts
 
   when (ty1 /= ty1') $ failMsg "A" ty1 ty1'
   when (ty2 /= ty2') $ failMsg "B" ty2 ty2'
diff --git a/testsuite/tests/typecheck/should_fail/T5095.stderr b/testsuite/tests/typecheck/should_fail/T5095.stderr
index e30898f74f..445b18754a 100644
--- a/testsuite/tests/typecheck/should_fail/T5095.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5095.stderr
@@ -4,9 +4,9 @@ T5095.hs:9:11: error:
       Matching instances:
         instance [overlappable] Show a => Eq a -- Defined at T5095.hs:5:31
         instance Eq Ordering -- Defined in ‘GHC.Classes’
-        instance Eq a => Eq (Maybe a) -- Defined in ‘GHC.Maybe’
-        ...plus 24 others
-        ...plus six instances involving out-of-scope types
+        instance Eq Integer -- Defined in ‘GHC.Num.Integer’
+        ...plus 23 others
+        ...plus four instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
       (The choice depends on the instantiation of ‘a’
        To pick the first instance above, use IncoherentInstances
diff --git a/testsuite/tests/typecheck/should_fail/tcfail118.stderr b/testsuite/tests/typecheck/should_fail/tcfail118.stderr
index 098af79736..705a68d87a 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail118.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail118.stderr
@@ -1,8 +1,8 @@
 
-tcfail118.hs:10:29:
-    Overlapping instances for Eq Foo
-      arising from the first field of ‘Bar’ (type ‘Foo’)
-    Matching instances:
-      instance Eq Foo -- Defined at tcfail118.hs:11:25
-      instance Eq Foo -- Defined at tcfail118.hs:13:10
-    When deriving the instance for (Eq Bar)
+tcfail118.hs:10:29: error:
+    • Overlapping instances for Eq Foo
+        arising from the first field of ‘Bar’ (type ‘Foo’)
+      Matching instances:
+        instance Eq Foo -- Defined at tcfail118.hs:13:10
+        instance Eq Foo -- Defined at tcfail118.hs:11:25
+    • When deriving the instance for (Eq Bar)