+getInitialKind :: LTyClDecl Name -> TcM (Name, TcKind)
+-- Only for data type and class declarations
+-- Get as much info as possible from the data or class decl,
+-- so as to maximise usefulness of error messages
+getInitialKind (L _ decl)
+ = do { arg_kinds <- mapM (mk_arg_kind . unLoc) (tyClDeclTyVars decl)
+ ; res_kind <- mk_res_kind decl
+ ; return (tcdName decl, mkArrowKinds arg_kinds res_kind) }
+ where
+ mk_arg_kind (UserTyVar _) = newKindVar
+ mk_arg_kind (KindedTyVar _ kind) = return kind
+
+ mk_res_kind (TyData { tcdKindSig = Just kind }) = return kind
+ -- On GADT-style declarations we allow a kind signature
+ -- data T :: *->* where { ... }
+ mk_res_kind other = return liftedTypeKind
+
+
+----------------
+kcSynDecls :: [SCC (LTyClDecl Name)]
+ -> TcM ([LTyClDecl Name], -- Kind-annotated decls
+ [(Name,TcKind)]) -- Kind bindings
+kcSynDecls []
+ = return ([], [])
+kcSynDecls (group : groups)
+ = do { (decl, nk) <- kcSynDecl group
+ ; (decls, nks) <- tcExtendKindEnv [nk] (kcSynDecls groups)
+ ; return (decl:decls, nk:nks) }
+
+----------------
+kcSynDecl :: SCC (LTyClDecl Name)
+ -> TcM (LTyClDecl Name, -- Kind-annotated decls
+ (Name,TcKind)) -- Kind bindings
+kcSynDecl (AcyclicSCC ldecl@(L loc decl))
+ = tcAddDeclCtxt decl $
+ kcHsTyVars (tcdTyVars decl) (\ k_tvs ->
+ do { traceTc (text "kcd1" <+> ppr (unLoc (tcdLName decl)) <+> brackets (ppr (tcdTyVars decl))
+ <+> brackets (ppr k_tvs))
+ ; (k_rhs, rhs_kind) <- kcHsType (tcdSynRhs decl)
+ ; traceTc (text "kcd2" <+> ppr (unLoc (tcdLName decl)))
+ ; let tc_kind = foldr (mkArrowKind . kindedTyVarKind) rhs_kind k_tvs
+ ; return (L loc (decl { tcdTyVars = k_tvs, tcdSynRhs = k_rhs }),
+ (unLoc (tcdLName decl), tc_kind)) })
+
+kcSynDecl (CyclicSCC decls)
+ = do { recSynErr decls; failM } -- Fail here to avoid error cascade
+ -- of out-of-scope tycons
+
+kindedTyVarKind (L _ (KindedTyVar _ k)) = k