Use transSuperClasses in TcErrors

Code in TcErrors was recursively using immSuperClasses,
which loops in the presence of UndecidableSuperClasses.

Better to use transSuperClasses instead, which has a loop-breaker
mechanism built in.

Fixes issue #16414.

2 files changed, 31 insertions, 12 deletions

diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs
index d56e344454..3f0f82cb1d 100644
--- a/compiler/typecheck/TcErrors.hs
+++ b/compiler/typecheck/TcErrors.hs
@@ -2577,15 +2577,15 @@ mk_dict_err ctxt@(CEC {cec_encl = implics}) (ct, (matches, unifiers, unsafe_over
                             2 (sep [ text "bound by" <+> ppr skol_info
                                    , text "at" <+>
                                      ppr (tcl_loc (implicLclEnv implic)) ])
-        where ev_vars_matching = filter ev_var_matches (map evVarPred evvars)
-              ev_var_matches ty = case getClassPredTys_maybe ty of
-                 Just (clas', tys')
-                   | clas' == clas
-                   , Just _ <- tcMatchTys tys tys'
-                   -> True
-                   | otherwise
-                   -> any ev_var_matches (immSuperClasses clas' tys')
-                 Nothing -> False
+        where ev_vars_matching = [ pred
+                                 | ev_var <- evvars
+                                 , let pred = evVarPred ev_var
+                                 , any can_match (pred : transSuperClasses pred) ]
+              can_match pred
+                 = case getClassPredTys_maybe pred of
+                     Just (clas', tys') -> clas' == clas
+                                          && isJust (tcMatchTys tys tys')
+                     Nothing -> False
 
     -- Overlap error because of Safe Haskell (first
     -- match should be the most specific match)
@@ -2716,7 +2716,7 @@ the alleged "provided" constraints, Show a.
 
 So we suppress that Implication in discardProvCtxtGivens.  It's
 painfully ad-hoc but the truth is that adding it to the "required"
-constraints would work.  Suprressing it solves two problems.  First,
+constraints would work.  Suppressing it solves two problems.  First,
 we never tell the user that we could not deduce a "provided"
 constraint from the "required" context. Second, we never give a
 possible fix that suggests to add a "provided" constraint to the
diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs
index 155037b775..d4bac5c12b 100644
--- a/compiler/typecheck/TcType.hs
+++ b/compiler/typecheck/TcType.hs
@@ -2011,8 +2011,25 @@ isInsolubleOccursCheck eq_rel tv ty
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 When we expand superclasses, we use the following algorithm:
 
-expand( so_far, pred ) returns the transitive superclasses of pred,
-                               not including pred itself
+transSuperClasses( C tys ) returns the transitive superclasses
+                           of (C tys), not including C itself
+
+For example
+  class C a b => D a b
+  class D b a => C a b
+
+Then
+  transSuperClasses( Ord ty )  = [Eq ty]
+  transSuperClasses( C ta tb ) = [D tb ta, C tb ta]
+
+Notice that in the recursive-superclass case we include C again at
+the end of the chain.  One could exclude C in this case, but
+the code is more awkward and there seems no good reason to do so.
+(However C.f. TcCanonical.mk_strict_superclasses, which /does/
+appear to do so.)
+
+The algorithm is expand( so_far, pred ):
+
  1. If pred is not a class constraint, return empty set
        Otherwise pred = C ts
  2. If C is in so_far, return empty set (breaks loops)
@@ -2024,6 +2041,8 @@ Notice that
  * With normal Haskell-98 classes, the loop-detector will never bite,
    so we'll get all the superclasses.
 
+ * We need the loop-breaker in case we have UndecidableSuperClasses on
+
  * Since there is only a finite number of distinct classes, expansion
    must terminate.