Fix #9415.

Abort typechecking when we detect a superclass cycle error, as
ambiguity checking in the presence of superclass cycle errors can
cause a loop.

1 files changed, 16 insertions, 1 deletions

diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index f09bef8081..2db31e33e4 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -1369,10 +1369,24 @@ since GADTs are not kind indexed.
 Validity checking is done once the mutually-recursive knot has been
 tied, so we can look at things freely.
 
+Note [Abort when superclass cycle is detected]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We must avoid doing the ambiguity check when there are already errors accumulated.
+This is because one of the errors may be a superclass cycle, and superclass cycles
+cause canonicalization to loop. Here is a representative example:
+
+  class D a => C a where
+    meth :: D a => ()
+  class C a => D a
+
+This fixes Trac #9415.
+
 \begin{code}
 checkClassCycleErrs :: Class -> TcM ()
 checkClassCycleErrs cls
-  = unless (null cls_cycles) $ mapM_ recClsErr cls_cycles
+  = unless (null cls_cycles) $
+    do { mapM_ recClsErr cls_cycles
+       ; failM }  -- See Note [Abort when superclass cycle is detected]
   where cls_cycles = calcClassCycles cls
 
 checkValidTyCl :: TyThing -> TcM ()
@@ -1623,6 +1637,7 @@ checkValidClass cls
         ; checkValidTheta (ClassSCCtxt (className cls)) theta
 
           -- Now check for cyclic superclasses
+          -- If there are superclass cycles, checkClassCycleErrs bails.
         ; checkClassCycleErrs cls
 
         -- Check the class operations