+\begin{code}
+kcHsTyVar :: HsTyVarBndr name -> TcM (name, TcKind)
+kcHsTyVars :: [HsTyVarBndr name] -> TcM [(name, TcKind)]
+
+kcHsTyVar (UserTyVar name) = newNamedKindVar name
+kcHsTyVar (IfaceTyVar name kind) = returnM (name, kind)
+
+kcHsTyVars tvs = mappM kcHsTyVar tvs
+
+newNamedKindVar name = newKindVar `thenM` \ kind ->
+ returnM (name, kind)
+
+---------------------------
+kcLiftedType :: RenamedHsType -> TcM ()
+ -- The type ty must be a *lifted* *type*
+kcLiftedType ty
+ = kcHsType ty `thenM` \ kind ->
+ addErrCtxt (typeKindCtxt ty) $
+ unifyKind liftedTypeKind kind
+
+---------------------------
+kcTypeType :: RenamedHsType -> TcM ()
+ -- The type ty must be a *type*, but it can be lifted or unlifted.
+kcTypeType ty
+ = kcHsType ty `thenM` \ kind ->
+ addErrCtxt (typeKindCtxt ty) $
+ unifyOpenTypeKind kind
+
+---------------------------
+kcHsSigType, kcHsLiftedSigType :: RenamedHsType -> TcM ()
+ -- Used for type signatures
+kcHsSigType = kcTypeType
+kcHsSigTypes tys = mappM_ kcHsSigType tys
+kcHsLiftedSigType = kcLiftedType
+
+---------------------------
+kcHsType :: RenamedHsType -> TcM TcKind
+kcHsType (HsTyVar name) = kcTyVar name
+
+kcHsType (HsKindSig ty k)
+ = kcHsType ty `thenM` \ k' ->
+ unifyKind k k' `thenM_`
+ returnM k
+
+kcHsType (HsListTy ty)
+ = kcLiftedType ty `thenM` \ tau_ty ->
+ returnM liftedTypeKind
+
+kcHsType (HsPArrTy ty)
+ = kcLiftedType ty `thenM` \ tau_ty ->
+ returnM liftedTypeKind
+
+kcHsType (HsTupleTy (HsTupCon boxity _) tys)
+ = mappM kcTypeType tys `thenM_`
+ returnM (case boxity of
+ Boxed -> liftedTypeKind
+ Unboxed -> unliftedTypeKind)
+
+kcHsType (HsFunTy ty1 ty2)
+ = kcTypeType ty1 `thenM_`
+ kcTypeType ty2 `thenM_`
+ returnM liftedTypeKind
+
+kcHsType (HsOpTy ty1 HsArrow ty2)
+ = kcTypeType ty1 `thenM_`
+ kcTypeType ty2 `thenM_`
+ returnM liftedTypeKind
+
+kcHsType ty@(HsOpTy ty1 (HsTyOp op) ty2)
+ = kcTyVar op `thenM` \ op_kind ->
+ kcHsType ty1 `thenM` \ ty1_kind ->
+ kcHsType ty2 `thenM` \ ty2_kind ->
+ addErrCtxt (appKindCtxt (ppr ty)) $
+ kcAppKind op_kind ty1_kind `thenM` \ op_kind' ->
+ kcAppKind op_kind' ty2_kind
+
+kcHsType (HsParTy ty) -- Skip parentheses markers
+ = kcHsType ty
+
+kcHsType (HsNumTy _) -- The unit type for generics
+ = returnM liftedTypeKind
+
+kcHsType (HsPredTy pred)
+ = kcHsPred pred `thenM_`
+ returnM liftedTypeKind
+
+kcHsType ty@(HsAppTy ty1 ty2)
+ = kcHsType ty1 `thenM` \ tc_kind ->
+ kcHsType ty2 `thenM` \ arg_kind ->
+ addErrCtxt (appKindCtxt (ppr ty)) $
+ kcAppKind tc_kind arg_kind
+
+kcHsType (HsForAllTy (Just tv_names) context ty)
+ = kcHsTyVars tv_names `thenM` \ kind_env ->
+ tcExtendKindEnv kind_env $
+ kcHsContext context `thenM_`
+ kcLiftedType ty `thenM_`
+ -- The body of a forall must be of kind *
+ -- In principle, I suppose, we could allow unlifted types,
+ -- but it seems simpler to stick to lifted types for now.
+ returnM liftedTypeKind
+
+---------------------------
+kcAppKind fun_kind arg_kind
+ = case tcSplitFunTy_maybe fun_kind of
+ Just (arg_kind', res_kind)
+ -> unifyKind arg_kind arg_kind' `thenM_`
+ returnM res_kind
+
+ Nothing -> newKindVar `thenM` \ res_kind ->
+ unifyKind fun_kind (mkArrowKind arg_kind res_kind) `thenM_`
+ returnM res_kind
+
+
+---------------------------
+kc_pred :: RenamedHsPred -> TcM TcKind -- Does *not* check for a saturated
+ -- application (reason: used from TcDeriv)
+kc_pred pred@(HsIParam name ty)
+ = kcHsType ty
+
+kc_pred pred@(HsClassP cls tys)
+ = kcClass cls `thenM` \ kind ->
+ mappM kcHsType tys `thenM` \ arg_kinds ->
+ newKindVar `thenM` \ kv ->
+ unifyKind kind (mkArrowKinds arg_kinds kv) `thenM_`
+ returnM kv
+
+---------------------------
+kcHsContext ctxt = mappM_ kcHsPred ctxt
+
+kcHsPred pred -- Checks that the result is of kind liftedType
+ = addErrCtxt (appKindCtxt (ppr pred)) $
+ kc_pred pred `thenM` \ kind ->
+ unifyKind liftedTypeKind kind `thenM_`
+ returnM ()
+
+
+ ---------------------------
+kcTyVar name -- Could be a tyvar or a tycon
+ = tcLookup name `thenM` \ thing ->
+ case thing of
+ AThing kind -> returnM kind
+ ATyVar tv -> returnM (tyVarKind tv)
+ AGlobal (ATyCon tc) -> returnM (tyConKind tc)
+ other -> failWithTc (wrongThingErr "type" thing name)
+
+kcClass cls -- Must be a class
+ = tcLookup cls `thenM` \ thing ->
+ case thing of
+ AThing kind -> returnM kind
+ AGlobal (AClass cls) -> returnM (tyConKind (classTyCon cls))
+ other -> failWithTc (wrongThingErr "class" thing cls)
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{tc_type}
+%* *
+%************************************************************************
+
+tc_type, the main work horse
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+ -------------------
+ *** BIG WARNING ***
+ -------------------
+
+tc_type is used to typecheck the types in the RHS of data
+constructors. In the case of recursive data types, that means that
+the type constructors themselves are (partly) black holes. e.g.
+
+ data T a = MkT a [T a]
+
+While typechecking the [T a] on the RHS, T itself is not yet fully
+defined. That in turn places restrictions on what you can check in
+tcHsType; if you poke on too much you get a black hole. I keep
+forgetting this, hence this warning!
+
+So tc_type does no validity-checking. Instead that's all done
+by TcMType.checkValidType
+
+ --------------------------
+ *** END OF BIG WARNING ***
+ --------------------------