-data Kind
- = LiftedTypeKind -- *
- | OpenTypeKind -- ?
- | UnliftedTypeKind -- #
- | UbxTupleKind -- (##)
- | ArgTypeKind -- ??
- | FunKind Kind Kind -- k1 -> k2
- | KindVar KindVar
- deriving( Eq )
-
-data KindVar = KVar Unique OccName (IORef (Maybe SimpleKind))
- -- INVARIANT: a KindVar can only be instantiated by a SimpleKind
-
-type SimpleKind = Kind
- -- A SimpleKind has no ? or # kinds in it:
- -- sk ::= * | sk1 -> sk2 | kvar
-
-instance Eq KindVar where
- (KVar u1 _ _) == (KVar u2 _ _) = u1 == u2
+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}