+typeKind :: Type -> Kind
+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)
+typeKind (ForAllTy _ ty) = typeKind ty
+typeKind (TyVarTy tyvar) = tyVarKind tyvar
+typeKind (FunTy _arg res)
+ -- Hack alert. The kind of (Int -> Int#) is liftedTypeKind (*),
+ -- not unliftedTypKind (#)
+ -- The only things that can be after a function arrow are
+ -- (a) types (of kind openTypeKind or its sub-kinds)
+ -- (b) kinds (of super-kind TY) (e.g. * -> (* -> *))
+ | isTySuperKind k = k
+ | otherwise = ASSERT( isSubOpenTypeKind k) liftedTypeKind
+ where
+ k = typeKind res
+
+------------------
+predKind :: PredType -> Kind
+predKind (EqPred {}) = unliftedTypeKind -- Coercions are unlifted
+predKind (ClassP {}) = liftedTypeKind -- Class and implicitPredicates are
+predKind (IParam {}) = liftedTypeKind -- always represented by lifted types
+\end{code}