X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypes%2FTypeRep.lhs;h=5ee0a353eb8767b0a4467473cd6f6e1a2421cf0e;hp=04cc11f7dc0fa20868585d0ed2b5214fb93ce411;hb=ac704fcac946590eef0ec91ae19f3b47d779a75f;hpb=28d732c362e13e58d653b3dc15fd376c3f0c54c2

diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs
index 04cc11f..5ee0a35 100644
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.lhs
@@ -22,7 +22,7 @@ module TypeRep (
 	liftedTypeKind, unliftedTypeKind, openTypeKind,
         argTypeKind, ubxTupleKind,
 	isLiftedTypeKindCon, isLiftedTypeKind,
-	mkArrowKind, mkArrowKinds,
+	mkArrowKind, mkArrowKinds, isCoercionKind,
 
         -- Kind constructors...
         liftedTypeKindTyCon, openTypeKindTyCon, unliftedTypeKindTyCon,
@@ -386,14 +386,21 @@ isCoSuperKind (TyConApp kc []) = kc `hasKey` coSuperKindTyConKey
 isCoSuperKind other            = False
 
 -------------------
--- lastly we need a few functions on Kinds
+-- Lastly we need a few functions on Kinds
 
 isLiftedTypeKindCon tc    = tc `hasKey` liftedTypeKindTyConKey
 
+isLiftedTypeKind :: Kind -> Bool
 isLiftedTypeKind (TyConApp tc []) = isLiftedTypeKindCon tc
 isLiftedTypeKind other            = False
 
-
+isCoercionKind :: Kind -> Bool
+-- All coercions are of form (ty1 :=: ty2)
+-- This function is here rather than in Coercion, 
+-- because it's used in a knot-tied way to enforce invariants in Var
+isCoercionKind (NoteTy _ k)         = isCoercionKind k
+isCoercionKind (PredTy (EqPred {})) = True
+isCoercionKind other		    = False
 \end{code}