X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FCoercion.lhs;h=c9de505c2a631647e4e4a6b69796ddfc205fc209;hb=67ee8a93fc96a38c3f73468cb86d8421a11d2911;hp=54061ed4fea3cea3a143034e2ebe9e7d74e9ebd9;hpb=a92db2a52d056ab962e4f55d5d8e3997ac3b8e4f;p=ghc-hetmet.git

diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs
index 54061ed..c9de505 100644
--- a/compiler/types/Coercion.lhs
+++ b/compiler/types/Coercion.lhs
@@ -36,7 +36,8 @@ module Coercion (
 import TypeRep
 import Type	  ( Type, Kind, PredType, substTyWith, mkAppTy, mkForAllTy,
                     mkFunTy, splitAppTy_maybe, splitForAllTy_maybe, coreView,
-                    kindView, mkTyConApp, isCoercionKind, isEqPred, mkAppTys
+                    kindView, mkTyConApp, isCoercionKind, isEqPred, mkAppTys,
+                    coreEqType
                   )
 import TyCon      ( TyCon, tyConArity, mkCoercionTyCon, isNewTyCon,
                     newTyConRhs, newTyConCo, 
@@ -309,7 +310,9 @@ symCoercionTyCon =
 transCoercionTyCon = 
   mkCoercionTyCon transCoercionTyConName 2 (mkKindingFun composeCoercionKindsOf)
   where
-    composeCoercionKindsOf (co1:co2:rest) = (a1, r2, rest)
+    composeCoercionKindsOf (co1:co2:rest) = 
+        WARN( not (r1 `coreEqType` a2), text "Strange! Type mismatch in trans coercion, probably a bug")
+        (a1, r2, rest)
       where
         (a1, r1) = coercionKind co1
         (a2, r2) = coercionKind co2