-\subsection{Kind checking}
-%* *
-%************************************************************************
-
-\begin{code}
-kcTyDecl :: RenamedTyClDecl -> TcM s ()
-
-kcTyDecl (TySynonym name tyvar_names rhs src_loc)
- = tcLookupTy name `thenNF_Tc` \ (kind, _, _) ->
- tcExtendTopTyVarScope kind tyvar_names $ \ _ result_kind ->
- tcHsTypeKind rhs `thenTc` \ (rhs_kind, _) ->
- unifyKind result_kind rhs_kind
-
-kcTyDecl (TyData _ context tycon_name tyvar_names con_decls _ _ src_loc)
- = tcLookupTy tycon_name `thenNF_Tc` \ (kind, _, _) ->
- tcExtendTopTyVarScope kind tyvar_names $ \ result_kind _ ->
- tcContext context `thenTc_`
- mapTc kcConDecl con_decls `thenTc_`
- returnTc ()
-
-kcConDecl (ConDecl _ ex_tvs ex_ctxt details loc)
- = tcAddSrcLoc loc (
- tcExtendTyVarScope ex_tvs ( \ tyvars ->
- tcContext ex_ctxt `thenTc_`
- kc_con details `thenTc_`
- returnTc ()
- ))
- where
- kc_con (VanillaCon btys) = mapTc kc_bty btys `thenTc_` returnTc ()
- kc_con (InfixCon bty1 bty2) = mapTc kc_bty [bty1,bty2] `thenTc_` returnTc ()
- kc_con (NewCon ty _) = tcHsType ty `thenTc_` returnTc ()
- kc_con (RecCon flds) = mapTc kc_field flds `thenTc_` returnTc ()
-
- kc_bty (Banged ty) = tcHsType ty
- kc_bty (Unbanged ty) = tcHsType ty
-
- kc_field (_, bty) = kc_bty bty
-\end{code}
-
-
-%************************************************************************
-%* *