X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypes%2FKind.lhs;h=668ddda92a44cbd7839b2d10c24878bce821d616;hp=23787d20e2bd81674f5e9f335608a7795323ae36;hb=c0687066474aa4ce4912f31a5c09c1bcd673fb06;hpb=fdf8656855d26105ff36bdd24d41827b05037b91;ds=sidebyside

diff --git a/compiler/types/Kind.lhs b/compiler/types/Kind.lhs
index 23787d2..668ddda 100644
--- a/compiler/types/Kind.lhs
+++ b/compiler/types/Kind.lhs
@@ -72,8 +72,11 @@ isLiftedTypeKindCon tc    = tc `hasKey` liftedTypeKindTyConKey
 
 \begin{code}
 typeKind :: Type -> Kind
-typeKind (TyConApp tc tys) 
-  = kindAppResult (tyConKind tc) tys
+typeKind _ty@(TyConApp tc tys) 
+  = ASSERT2( not (tc `hasKey` eqPredPrimTyConKey) || length tys == 2, ppr _ty )
+    	     -- Assertion checks for unsaturated application of (~)
+	     -- See Note [The (~) TyCon] in TysPrim
+    kindAppResult (tyConKind tc) tys
 
 typeKind (PredTy pred)	      = predKind pred
 typeKind (AppTy fun _)        = kindFunResult (typeKind fun)
@@ -229,4 +232,5 @@ defaultKind k
   | isSubOpenTypeKind k = liftedTypeKind
   | isSubArgTypeKind k  = liftedTypeKind
   | otherwise        = k
+
 \end{code}
\ No newline at end of file