+kcTyClDecls syn_decls alg_decls
+ = do { -- First extend the kind env with each data
+ -- type and class, mapping them to a type variable
+ alg_kinds <- mappM getInitialKind alg_decls
+ ; tcExtendKindEnv alg_kinds $ do
+
+ -- Now kind-check the type synonyms, in dependency order
+ -- We do these differently to data type and classes,
+ -- because a type synonym can be an unboxed type
+ -- type Foo = Int#
+ -- and a kind variable can't unify with UnboxedTypeKind
+ -- So we infer their kinds in dependency order
+ { (kc_syn_decls, syn_kinds) <- kcSynDecls (calcSynCycles syn_decls)
+ ; tcExtendKindEnv syn_kinds $ do
+
+ -- Now kind-check the data type and class declarations,
+ -- returning kind-annotated decls
+ { kc_alg_decls <- mappM (wrapLocM kcTyClDecl) alg_decls
+
+ ; return (kc_syn_decls, kc_alg_decls) }}}
+
+------------------------------------------------------------------------
+getInitialKind :: LTyClDecl Name -> TcM (Name, TcKind)
+
+getInitialKind decl
+ = newKindVar `thenM` \ kind ->
+ returnM (unLoc (tcdLName (unLoc decl)), kind)
+
+----------------
+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
+
+------------------------------------------------------------------------
+kcTyClDecl :: TyClDecl Name -> TcM (TyClDecl Name)
+ -- Not used for type synonyms (see kcSynDecl)
+
+kcTyClDecl decl@(TyData {tcdND = new_or_data, tcdCtxt = ctxt, tcdCons = cons})
+ = kcTyClDeclBody decl $ \ tvs' ->
+ do { ctxt' <- kcHsContext ctxt
+ ; cons' <- mappM (wrapLocM kc_con_decl) cons
+ ; return (decl {tcdTyVars = tvs', tcdCtxt = ctxt', tcdCons = cons'}) }