+
+tySuperKindTyCon = mkSuperKindTyCon tySuperKindTyConName
+coSuperKindTyCon = mkSuperKindTyCon coSuperKindTyConName
+
+liftedTypeKindTyCon = mkKindTyCon liftedTypeKindTyConName
+openTypeKindTyCon = mkKindTyCon openTypeKindTyConName
+unliftedTypeKindTyCon = mkKindTyCon unliftedTypeKindTyConName
+ubxTupleKindTyCon = mkKindTyCon ubxTupleKindTyConName
+argTypeKindTyCon = mkKindTyCon argTypeKindTyConName
+
+mkKindTyCon :: Name -> TyCon
+mkKindTyCon name = mkVoidPrimTyCon name tySuperKind 0
+
+--------------------------
+-- ... and now their names
+
+tySuperKindTyConName = mkPrimTyConName (fsLit "BOX") tySuperKindTyConKey tySuperKindTyCon
+coSuperKindTyConName = mkPrimTyConName (fsLit "COERCION") coSuperKindTyConKey coSuperKindTyCon
+liftedTypeKindTyConName = mkPrimTyConName (fsLit "*") liftedTypeKindTyConKey liftedTypeKindTyCon
+openTypeKindTyConName = mkPrimTyConName (fsLit "?") openTypeKindTyConKey openTypeKindTyCon
+unliftedTypeKindTyConName = mkPrimTyConName (fsLit "#") unliftedTypeKindTyConKey unliftedTypeKindTyCon
+ubxTupleKindTyConName = mkPrimTyConName (fsLit "(#)") ubxTupleKindTyConKey ubxTupleKindTyCon
+argTypeKindTyConName = mkPrimTyConName (fsLit "??") argTypeKindTyConKey argTypeKindTyCon
+funTyConName = mkPrimTyConName (fsLit "(->)") funTyConKey funTyCon
+
+mkPrimTyConName :: FastString -> Unique -> TyCon -> Name
+mkPrimTyConName occ key tycon = mkWiredInName gHC_PRIM (mkTcOccFS occ)
+ key
+ (ATyCon tycon)
+ BuiltInSyntax
+ -- All of the super kinds and kinds are defined in Prim and use BuiltInSyntax,
+ -- because they are never in scope in the source
+
+------------------
+-- We also need Kinds and SuperKinds, locally and in TyCon
+
+kindTyConType :: TyCon -> Type
+kindTyConType kind = TyConApp kind []
+
+-- | See "Type#kind_subtyping" for details of the distinction between these 'Kind's
+liftedTypeKind, unliftedTypeKind, openTypeKind, argTypeKind, ubxTupleKind :: Kind
+
+liftedTypeKind = kindTyConType liftedTypeKindTyCon
+unliftedTypeKind = kindTyConType unliftedTypeKindTyCon
+openTypeKind = kindTyConType openTypeKindTyCon
+argTypeKind = kindTyConType argTypeKindTyCon
+ubxTupleKind = kindTyConType ubxTupleKindTyCon
+
+-- | Given two kinds @k1@ and @k2@, creates the 'Kind' @k1 -> k2@
+mkArrowKind :: Kind -> Kind -> Kind
+mkArrowKind k1 k2 = FunTy k1 k2
+
+-- | Iterated application of 'mkArrowKind'
+mkArrowKinds :: [Kind] -> Kind -> Kind
+mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind arg_kinds
+
+tySuperKind, coSuperKind :: SuperKind
+tySuperKind = kindTyConType tySuperKindTyCon
+coSuperKind = kindTyConType coSuperKindTyCon
+
+isTySuperKind :: SuperKind -> Bool
+isTySuperKind (TyConApp kc []) = kc `hasKey` tySuperKindTyConKey
+isTySuperKind _ = False
+
+isCoSuperKind :: SuperKind -> Bool
+isCoSuperKind (TyConApp kc []) = kc `hasKey` coSuperKindTyConKey
+isCoSuperKind _ = False
+
+-------------------
+-- Lastly we need a few functions on Kinds
+
+isLiftedTypeKindCon :: TyCon -> Bool
+isLiftedTypeKindCon tc = tc `hasKey` liftedTypeKindTyConKey
+
+isLiftedTypeKind :: Kind -> Bool
+isLiftedTypeKind (TyConApp tc []) = isLiftedTypeKindCon tc
+isLiftedTypeKind _ = 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 (PredTy (EqPred {})) = True
+isCoercionKind _ = False
+
+coVarPred :: CoVar -> PredType
+coVarPred tv
+ = ASSERT( isCoVar tv )
+ case tyVarKind tv of
+ PredTy eq -> eq
+ other -> pprPanic "coVarPred" (ppr tv $$ ppr other)