[commit: ghc] wip/rae: Fix #9415. (beb3e69)

[git at git.haskell.org]

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

On branch  : wip/rae
Link       : http://ghc.haskell.org/trac/ghc/changeset/beb3e69892c493be8c35f9a030ef4dca4c12b721/ghc

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

commit beb3e69892c493be8c35f9a030ef4dca4c12b721
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Wed Aug 6 09:51:26 2014 -0400

    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.


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

beb3e69892c493be8c35f9a030ef4dca4c12b721
 compiler/typecheck/TcTyClsDecls.lhs | 17 ++++++++++++++++-
 1 file changed, 16 insertions(+), 1 deletion(-)

diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index f09bef8..2db31e3 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