Commit 7c796336 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Fix the superclass-cycle detection code (Trac #9739)

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.
parent c639560d
...@@ -825,6 +825,9 @@ checkNoErrs main ...@@ -825,6 +825,9 @@ checkNoErrs main
Just val -> return val Just val -> return val
} }
whenNoErrs :: TcM () -> TcM ()
whenNoErrs thing = ifErrsM (return ()) thing
ifErrsM :: TcRn r -> TcRn r -> TcRn r ifErrsM :: TcRn r -> TcRn r -> TcRn r
-- ifErrsM bale_out normal -- ifErrsM bale_out normal
-- does 'bale_out' if there are errors in errors collection -- does 'bale_out' if there are errors in errors collection
......
...@@ -1357,25 +1357,9 @@ since GADTs are not kind indexed. ...@@ -1357,25 +1357,9 @@ since GADTs are not kind indexed.
Validity checking is done once the mutually-recursive knot has been Validity checking is done once the mutually-recursive knot has been
tied, so we can look at things freely. 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} \begin{code}
checkClassCycleErrs :: Class -> TcM () checkClassCycleErrs :: Class -> TcM ()
checkClassCycleErrs cls checkClassCycleErrs cls = mapM_ recClsErr (calcClassCycles cls)
= 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 () checkValidTyCl :: TyThing -> TcM ()
checkValidTyCl thing checkValidTyCl thing
...@@ -1628,8 +1612,11 @@ checkValidClass cls ...@@ -1628,8 +1612,11 @@ checkValidClass cls
-- If there are superclass cycles, checkClassCycleErrs bails. -- If there are superclass cycles, checkClassCycleErrs bails.
; checkClassCycleErrs cls ; checkClassCycleErrs cls
-- Check the class operations -- Check the class operations.
; mapM_ (check_op constrained_class_methods) op_stuff -- 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 -- Check the associated type defaults are well-formed and instantiated
; mapM_ check_at_defs at_stuff } ; mapM_ check_at_defs at_stuff }
...@@ -1695,6 +1682,20 @@ checkFamFlag tc_name ...@@ -1695,6 +1682,20 @@ checkFamFlag tc_name
2 (ptext (sLit "Use TypeFamilies to allow indexed type families")) 2 (ptext (sLit "Use TypeFamilies to allow indexed type families"))
\end{code} \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 Checking role validity
......
{-# LANGUAGE MultiParamTypeClasses #-}
module T9739 where module T9739 where
class Class2 a => Class1 a where class Class3 a => Class1 a where
class3 :: (Class2 a) => b
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
T9739.hs:3:1: T9739.hs:4:1:
Cycle in class declaration (via superclasses): Cycle in class declaration (via superclasses):
Class1 -> Class2 -> Class1 Class1 -> Class3 -> Class1
In the class declaration for ‘Class1’ In the class declaration for ‘Class1’
T9739.hs:6:1: T9739.hs:9:1:
Cycle in class declaration (via superclasses): Cycle in class declaration (via superclasses):
Class2 -> Class1 -> Class2 Class3 -> Class1 -> Class3
In the class declaration for ‘Class2 In the class declaration for ‘Class3
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment