From 3c012e3b85faa92729995b3e946327314054762e Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Mon, 29 Jan 2001 14:28:06 +0000
Subject: [PATCH] [project @ 2001-01-29 14:28:06 by simonpj] Fix superclass
 bug in context reduction (gave infinite loops before!)

---
 ghc/compiler/typecheck/TcSimplify.lhs |   26 ++++++++++++++++++--------
 1 file changed, 18 insertions(+), 8 deletions(-)

diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index d4617b2..b8db28d 100644
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -1027,20 +1027,30 @@ addFree (avails, frees) free
     avail | instBindingRequired free = BoundTo (instToId free)
 	  | otherwise		     = NoRhs
 
-addGiven :: RedState -> Inst -> NF_TcM RedState
-addGiven state given = add_avail state given (BoundTo (instToId given))
-
-addIrred :: RedState -> Inst -> NF_TcM RedState
-addIrred state irred = add_avail state irred Irred
-
 addWanted :: RedState -> Inst -> TcExpr -> [Inst] -> NF_TcM RedState
-addWanted state wanted rhs_expr wanteds
+addWanted state@(avails, frees) wanted rhs_expr wanteds
+-- Do *not* add superclasses as well.  Here's an example of why not
+-- 	class Eq a => Foo a b 
+--	instance Eq a => Foo [a] a
+-- If we are reducing
+--	(Foo [t] t)
+-- we'll first deduce that it holds (via the instance decl).  We  
+-- must not then overwrite the Eq t constraint with a superclass selection!
+-- 	ToDo: this isn't entirely unsatisfactory, because
+--	      we may also lose some entirely-legitimate sharing this way
+
   = ASSERT( not (isAvailable state wanted) )
-    add_avail state wanted avail
+    returnNF_Tc (addToFM avails wanted avail, frees)
   where 
     avail | instBindingRequired wanted = Rhs rhs_expr wanteds
 	  | otherwise		       = ASSERT( null wanteds ) NoRhs
 
+addGiven :: RedState -> Inst -> NF_TcM RedState
+addGiven state given = add_avail state given (BoundTo (instToId given))
+
+addIrred :: RedState -> Inst -> NF_TcM RedState
+addIrred state irred = add_avail state irred Irred
+
 add_avail :: RedState -> Inst -> Avail -> NF_TcM RedState
 add_avail (avails, frees) wanted avail
   = addAvail avails wanted avail	`thenNF_Tc` \ avails' ->
-- 
1.7.10.4