X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcCanonical.lhs;h=88414d964fb5da4184ab3351f7b0bccec401708e;hb=a40f2735958055f7ff94e5df73e710044aa63b2c;hp=d72fae40833234ad6b3a6f9943ed0a83e8508852;hpb=2207ce8cdc4c33838f77f285c7dd4f7c75dbae1c;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcCanonical.lhs b/compiler/typecheck/TcCanonical.lhs
index d72fae4..88414d9 100644
--- a/compiler/typecheck/TcCanonical.lhs
+++ b/compiler/typecheck/TcCanonical.lhs
@@ -578,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
@@ -596,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