Fix debugger

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

diff --git a/compiler/typecheck/TcCanonical.lhs b/compiler/typecheck/TcCanonical.lhs
index b870b86..88414d9 100644 (file)
--- a/compiler/typecheck/TcCanonical.lhs
+++ b/compiler/typecheck/TcCanonical.lhs
@@ -528,11 +528,10 @@ reOrient (FunCls {})   (VarCls tv2)   = isMetaTyVar tv2
   -- meta type variable is the RHS of a function equality
 reOrient (FunCls {}) _                = False   -- Fun/Other on rhs
 
-
-reOrient (VarCls tv1) (FunCls {}) = not (isMetaTyVar tv1)
+reOrient (VarCls tv1) (FunCls {})   = not (isMetaTyVar tv1)
 reOrient (VarCls {})  (OtherCls {}) = False
+reOrient (VarCls {})  (VarCls {})   = False 
 
-reOrient (VarCls tv1) (VarCls tv2) = False 
 {- 
 -- Variables-variables are oriented according to their kind 
 -- so that the following property has the best chance of
@@ -579,9 +578,8 @@ canEqLeafOriented :: CtFlavor -> CoVar
 canEqLeafOriented fl cv cls1@(FunCls fn tys) s2 
   | let k1 = kindAppResult (tyConKind fn) tys, 
     let k2 = typeKind s2, 
-    isGiven fl && not (k1 `eqKind` k2) -- Establish the kind invariant for CFunEqCan
-  = do { kindErrorTcS fl (unClassify cls1) s2
-       ; return emptyCCan }
+    isGiven fl && not (k1 `eqKind` k2)   -- Establish the kind invariant for CFunEqCan
+  = kindErrorTcS fl (unClassify cls1) s2 -- Eagerly fails, see Note [Kind errors] in TcInteract
   | otherwise 
   = ASSERT2( isSynFamilyTyCon fn, ppr (unClassify cls1) )
     do { (xis1,ccs1) <- flattenMany fl tys -- flatten type function arguments
@@ -597,8 +595,7 @@ canEqLeafOriented fl cv cls1@(FunCls fn tys) s2
 -- and then do an occurs check.
 canEqLeafOriented fl cv (VarCls tv) s2 
   | isGiven fl && not (k1 `eqKind` k2) -- Establish the kind invariant for CTyEqCan
-  = do { kindErrorTcS fl (mkTyVarTy tv) s2
-       ; return emptyCCan }
+  = kindErrorTcS fl (mkTyVarTy tv) s2  -- Eagerly fails, see Note [Kind errors] in TcInteract
 
   | otherwise
   = do { (xi2,ccs2) <- flatten fl s2      -- flatten RHS