-tcGroup :: TcEnv s -> InstanceMapper -> SCC RenamedHsDecl -> TcM s ([TyCon], [Class])
-tcGroup unf_env inst_mapper scc
- = -- TIE THE KNOT
- fixTc ( \ ~(rec_tycons, rec_classes) ->
-
- -- EXTEND TYPE AND CLASS ENVIRONMENTS
- let
- mk_tycon_bind (name, arity) = newKindVar `thenNF_Tc` \ kind ->
- returnNF_Tc (name, (kind, arity, find name rec_tycons))
-
- mk_class_bind (name, arity) = newKindVars arity `thenNF_Tc` \ kinds ->
- returnNF_Tc (name, (kinds, find name rec_classes))
-
- find name [] = pprPanic "tcGroup" (ppr name)
- find name (thing:things) | name == getName thing = thing
- | otherwise = find name things
-
- in
- mapNF_Tc mk_tycon_bind tycon_names_w_arities `thenNF_Tc` \ tycon_binds ->
- mapNF_Tc mk_class_bind class_names_w_arities `thenNF_Tc` \ class_binds ->
- tcExtendTyConEnv tycon_binds $
- tcExtendClassEnv class_binds $
-
- -- DEAL WITH TYPE VARIABLES
- tcTyVarScope tyvar_names ( \ tyvars ->
-
- -- DEAL WITH THE DEFINITIONS THEMSELVES
- foldlTc (tcDecl is_rec_group unf_env inst_mapper) ([], []) decls
- ) `thenTc` \ (tycons, classes) ->
-
- returnTc (tycons, classes)
- )
+tcGroup :: RecTcEnv -> SCC RenamedTyClDecl -> TcM TcEnv
+tcGroup unf_env scc
+ = getDOptsTc `thenTc` \ dflags ->
+ -- Step 1
+ mapNF_Tc getInitialKind decls `thenNF_Tc` \ initial_kinds ->
+
+ -- Step 2
+ tcExtendKindEnv initial_kinds (mapTc kcTyClDecl decls) `thenTc_`
+
+ -- Step 3
+ zonkKindEnv initial_kinds `thenNF_Tc` \ final_kinds ->
+
+ -- Tie the knot
+ fixTc ( \ ~(rec_details_list, _, _) ->
+ -- Step 4
+ let
+ kind_env = mkNameEnv final_kinds
+ rec_details = mkNameEnv rec_details_list
+
+ tyclss, all_tyclss :: [TyThing]
+ tyclss = map (buildTyConOrClass dflags is_rec kind_env
+ rec_vrcs rec_details) decls
+
+ -- Add the tycons that come from the classes
+ -- We want them in the environment because
+ -- they are mentioned in interface files
+ all_tyclss = [ ATyCon (classTyCon clas) | AClass clas <- tyclss]
+ ++ tyclss
+
+ -- Calculate variances, and (yes!) feed back into buildTyConOrClass.
+ rec_vrcs = calcTyConArgVrcs [tc | ATyCon tc <- all_tyclss]
+ in
+ -- Step 5
+ tcExtendGlobalEnv all_tyclss $
+ mapTc (tcTyClDecl1 is_rec unf_env) decls `thenTc` \ tycls_details ->
+
+ -- Return results
+ tcGetEnv `thenNF_Tc` \ env ->
+ returnTc (tycls_details, all_tyclss, env)
+ ) `thenTc` \ (_, all_tyclss, env) ->
+
+ tcSetEnv env $
+
+ -- Step 6
+ -- For a recursive group, check all the types again,
+ -- this time with the wimp flag off
+ (if isRec is_rec then
+ mapTc_ (tcTyClDecl1 NonRecursive unf_env) decls
+ else
+ returnTc ()
+ ) `thenTc_`
+
+ -- Step 7
+ -- Extend the environment with the final TyCons/Classes
+ -- and their implicit Ids
+ tcExtendGlobalValEnv (implicitTyThingIds all_tyclss) tcGetEnv
+