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
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
......
......@@ -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
......
{-# 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
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
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