+tcGroup :: ValueEnv -> InstanceMapper -> SCC RenamedTyClDecl -> TcM s TcEnv
+tcGroup unf_env inst_mapper scc
+ = -- Do kind checking
+ mapNF_Tc getTyBinding1 decls `thenNF_Tc` \ ty_env_stuff1 ->
+ tcExtendTypeEnv ty_env_stuff1 (mapTc kcDecl decls) `thenTc_`
+
+ -- Tie the knot
+-- traceTc (ppr (map fst ty_env_stuff1)) `thenTc_`
+ fixTc ( \ ~(rec_tyclss, rec_vrcs, _) ->
+ let
+ rec_env = listToUFM rec_tyclss
+ in
+
+ -- Do type checking
+ mapNF_Tc (getTyBinding2 rec_env) ty_env_stuff1 `thenNF_Tc` \ ty_env_stuff2 ->
+ tcExtendTypeEnv ty_env_stuff2 $
+ mapTc (tcDecl is_rec_group unf_env inst_mapper rec_vrcs) decls
+ `thenTc` \ tyclss ->
+
+ tcGetEnv `thenTc` \ env ->
+ let
+ tycons = getAllEnvTyCons env
+ vrcs = calcTyConArgVrcs tycons
+ in
+
+ returnTc (tyclss, vrcs, env)
+ ) `thenTc` \ (_, _, env) ->
+-- traceTc (text "done" <+> ppr (map fst ty_env_stuff1)) `thenTc_`
+ returnTc env
+ where
+ is_rec_group = case scc of
+ AcyclicSCC _ -> NonRecursive
+ CyclicSCC _ -> Recursive
+
+ decls = case scc of
+ AcyclicSCC decl -> [decl]
+ CyclicSCC decls -> decls
+\end{code}
+
+Dealing with one decl
+~~~~~~~~~~~~~~~~~~~~~
+\begin{code}
+kcDecl decl
+ = tcAddDeclCtxt decl $
+ if isClassDecl decl then
+ kcClassDecl decl
+ else
+ kcTyDecl decl
+
+tcDecl :: RecFlag -- True => recursive group
+ -> ValueEnv -> InstanceMapper -> FiniteMap Name ArgVrcs
+ -> RenamedTyClDecl -> TcM s (Name, TcTyThing)
+
+tcDecl is_rec_group unf_env inst_mapper vrcs_env decl
+ = tcAddDeclCtxt decl $
+-- traceTc (text "Starting" <+> ppr name) `thenTc_`
+ if isClassDecl decl then
+ tcClassDecl1 unf_env inst_mapper vrcs_env decl `thenTc` \ clas ->
+-- traceTc (text "Finished" <+> ppr name) `thenTc_`
+ returnTc (getName clas, AClass clas)
+ else
+ tcTyDecl is_rec_group vrcs_env decl `thenTc` \ tycon ->
+-- traceTc (text "Finished" <+> ppr name) `thenTc_`
+ returnTc (getName tycon, ATyCon tycon)
+
+ where
+ name = tyClDeclName decl
+