Fix the superclass-cycle detection code (Trac #9739)
authorSimon Peyton Jones <simonpj@microsoft.com>
Fri, 31 Oct 2014 12:31:59 +0000 (12:31 +0000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Tue, 4 Nov 2014 10:38:04 +0000 (10:38 +0000)
We were falling into an infinite loop when doing the ambiguity
check on a class method, even though we had previously detected
a superclass cycle.  There was code to deal with this, but it
wasn't right.

compiler/typecheck/TcRnMonad.lhs
compiler/typecheck/TcTyClsDecls.lhs
testsuite/tests/typecheck/should_fail/T9739.hs
testsuite/tests/typecheck/should_fail/T9739.stderr

index dce4b49..cd41499 100644 (file)
@@ -825,6 +825,9 @@ checkNoErrs main
             Just val -> return val
         }
 
+whenNoErrs :: TcM () -> TcM ()
+whenNoErrs thing = ifErrsM (return ()) thing
+
 ifErrsM :: TcRn r -> TcRn r -> TcRn r
 --      ifErrsM bale_out normal
 -- does 'bale_out' if there are errors in errors collection
index fd3c8f8..e08f269 100644 (file)
@@ -1357,25 +1357,9 @@ 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) $
-    do { mapM_ recClsErr cls_cycles
-       ; failM }  -- See Note [Abort when superclass cycle is detected]
-  where cls_cycles = calcClassCycles cls
+checkClassCycleErrs cls = mapM_ recClsErr (calcClassCycles cls)
 
 checkValidTyCl :: TyThing -> TcM ()
 checkValidTyCl thing
@@ -1628,8 +1612,11 @@ checkValidClass cls
           -- If there are superclass cycles, checkClassCycleErrs bails.
         ; checkClassCycleErrs cls
 
-        -- Check the class operations
-        ; mapM_ (check_op constrained_class_methods) op_stuff
+        -- Check the class operations.
+        -- But only if there have been no earlier errors
+        -- See Note [Abort when superclass cycle is detected]
+        ; whenNoErrs $
+          mapM_ (check_op constrained_class_methods) op_stuff
 
         -- Check the associated type defaults are well-formed and instantiated
         ; mapM_ check_at_defs at_stuff  }
@@ -1695,6 +1682,20 @@ checkFamFlag tc_name
                  2 (ptext (sLit "Use TypeFamilies to allow indexed type families"))
 \end{code}
 
+Note [Abort when superclass cycle is detected]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We must avoid doing the ambiguity check for the methods (in
+checkValidClass.check_op) 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, #9739
+
 %************************************************************************
 %*                                                                      *
                 Checking role validity
index 4b7869d..18df797 100644 (file)
@@ -1,6 +1,9 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
 module T9739 where
 
-class Class2 a => Class1 a where
-  class3 :: (Class2 a) => b
+class Class3 a => Class1 a where
 
-class (Class1 a) => Class2 a where
+class Class2 t a where
+  class2 :: (Class3 t) => a -> m
+
+class (Class1 t, Class2 t t) => Class3 t where
index 95fcf6a..34e2f11 100644 (file)
@@ -1,10 +1,10 @@
 
-T9739.hs:3:1:
+T9739.hs:4:1:
     Cycle in class declaration (via superclasses):
-      Class1 -> Class2 -> Class1
+      Class1 -> Class3 -> Class1
     In the class declaration for ‘Class1’
 
-T9739.hs:6:1:
+T9739.hs:9:1:
     Cycle in class declaration (via superclasses):
-      Class2 -> Class1 -> Class2
-    In the class declaration for ‘Class2
+      Class3 -> Class1 -> Class3
+    In the class declaration for ‘Class3