[project @ 2004-12-06 10:51:36 by simonpj]

------------------------------------
	Bug in loop detection in TcSimplify
	------------------------------------

The type-class context simplifier has been able to
build recursive dictionaries for some time: co-induction.
That is, you can build a proof for constraint C by assuming
that C holds when proving the preconditions of C.

You need to be in -fallow-undecidable-instances land to
make use of this: see comments with [RECURSIVE DICTIONARIES]
in TcSimplify.lhs.

Anyway, this is all fine, but I'd implemented it wrong!  You need
to be very careful with superclasses, or you can make a bogus
loop by mistake.  This commit fixes it; tests LoopOfTheDay{1,2,3}
will test it (thanks Ralf Laemmel).

diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index f24b5de..beecfb4 100644 (file)
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -1754,7 +1754,7 @@ addAvailAndSCs avails inst avail
     avails1     = addToFM avails inst avail
     is_loop inst = any (`tcEqType` idType (instToId inst)) dep_tys
                        -- Note: this compares by *type*, not by Unique
-    deps         = findAllDeps emptyVarSet avail
+    deps         = findAllDeps (unitVarSet (instToId inst)) avail
     dep_tys     = map idType (varSetElems deps)
 
     findAllDeps :: IdSet -> Avail -> IdSet
@@ -1762,12 +1762,17 @@ addAvailAndSCs avails inst avail
     -- See Note [SUPERCLASS-LOOP]
     -- Watch out, though.  Since the avails may contain loops 
     -- (see Note [RECURSIVE DICTIONARIES]), so we need to track the ones we've seen so far
-    findAllDeps so_far (Rhs _ kids) 
-      = foldl findAllDeps
-             (extendVarSetList so_far (map instToId kids))     -- Add the kids to so_far
-              [a | Just a <- map (lookupFM avails) kids]       -- Find the kids' Avail
-    findAllDeps so_far other = so_far
-
+    findAllDeps so_far (Rhs _ kids) = foldl find_all so_far kids
+    findAllDeps so_far other       = so_far
+
+    find_all :: IdSet -> Inst -> IdSet
+    find_all so_far kid
+      | kid_id `elemVarSet` so_far       = so_far
+      | Just avail <- lookupFM avails kid = findAllDeps so_far' avail
+      | otherwise                        = so_far'
+      where
+       so_far' = extendVarSet so_far kid_id    -- Add the new kid to so_far
+       kid_id = instToId kid
 
 addSCs :: (Inst -> Bool) -> Avails -> Inst -> TcM Avails
        -- Add all the superclasses of the Inst to Avails