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

[git at git.haskell.org]

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

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

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

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

    Fix #9415.
    
    Don't do an ambiguity check when there are already errors, as
    a superclass cycle causes the ambiguity check to loop!


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

3ba140aa6f68481e35258724869320f0f95f5c52
 compiler/typecheck/TcValidity.lhs | 14 +++++++++++++-
 1 file changed, 13 insertions(+), 1 deletion(-)

diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs
index f835782..c4e0cdd 100644
--- a/compiler/typecheck/TcValidity.lhs
+++ b/compiler/typecheck/TcValidity.lhs
@@ -59,6 +59,17 @@ import Data.List        ( (\\) )
 %*                                                                      *
 %************************************************************************
 
+Note [No ambiguity check with errors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+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}
 checkAmbiguity :: UserTypeCtxt -> Type -> TcM ()
@@ -72,7 +83,8 @@ checkAmbiguity ctxt ty
   = return () 
 
   | otherwise
-  = do { traceTc "Ambiguity check for" (ppr ty)
+  = ifErrsM (return ()) $ -- See Note [No ambiguity check with errors]
+    do { traceTc "Ambiguity check for" (ppr ty)
        ; let free_tkvs = varSetElemsKvsFirst (closeOverKinds (tyVarsOfType ty))
        ; (subst, _tvs) <- tcInstSkolTyVars free_tkvs
        ; let ty' = substTy subst ty