Fix recursive superclasses (again). Fixes Trac #4809.

[ghc-hetmet.git] / compiler / typecheck / Inst.lhs

diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index 3a419be..1496ec5 100644 (file)
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -404,10 +404,18 @@ addLocalInst home_ie ispec
                -- This is important because the template variables must
                -- not overlap with anything in the things being looked up
                -- (since we do unification).  
-               -- We use tcInstSkolType because we don't want to allocate fresh
-               --  *meta* type variables.  
+                --
+                -- We use tcInstSkolType because we don't want to allocate fresh
+                --  *meta* type variables.
+                --
+                -- We use UnkSkol --- and *not* InstSkol or PatSkol --- because
+                -- these variables must be bindable by tcUnifyTys.  See
+                -- the call to tcUnifyTys in InstEnv, and the special
+                -- treatment that instanceBindFun gives to isOverlappableTyVar
+                -- This is absurdly delicate.
+
          let dfun = instanceDFunId ispec
-       ; (tvs', theta', tau') <- tcInstSkolType InstSkol (idType dfun)
+        ; (tvs', theta', tau') <- tcInstSkolType UnkSkol (idType dfun)
        ; let   (cls, tys') = tcSplitDFunHead tau'
                dfun'       = setIdType dfun (mkSigmaTy tvs' theta' tau')           
                ispec'      = setInstanceDFunId ispec dfun'
@@ -473,11 +481,9 @@ hasEqualities :: [EvVar] -> Bool
 -- Has a bunch of canonical constraints (all givens) got any equalities in it?
 hasEqualities givens = any (has_eq . evVarPred) givens
   where
-    has_eq (EqPred {})             = True
-    has_eq (IParam {})             = False
-    has_eq (ClassP cls tys) = any has_eq (substTheta subst (classSCTheta cls))
-      where
-        subst = zipOpenTvSubst (classTyVars cls) tys
+    has_eq (EqPred {})              = True
+    has_eq (IParam {})              = False
+    has_eq (ClassP cls _tys) = any has_eq (classSCTheta cls)
 
 ----------------
 tyVarsOfWanteds :: WantedConstraints -> TyVarSet