+%************************************************************************
+%* *
+\subsection{Step 4: Building the tycon/class}
+%* *
+%************************************************************************
+
+\begin{code}
+buildTyConOrClass
+ :: RecFlag -> NameEnv Kind
+ -> FiniteMap TyCon ArgVrcs -> NameEnv TyThingDetails
+ -> RenamedTyClDecl -> (Name, TyThing)
+ -- Can't fail; the only reason it's in the monad
+ -- is so it can zonk the kinds
+
+buildTyConOrClass is_rec kenv rec_vrcs rec_details
+ (TySynonym tycon_name tyvar_names rhs src_loc)
+ = (tycon_name, ATyCon tycon)
+ where
+ tycon = mkSynTyCon tycon_name tycon_kind arity tyvars rhs_ty argvrcs
+ tycon_kind = lookupNameEnv_NF kenv tycon_name
+ arity = length tyvar_names
+ tyvars = mkTyClTyVars tycon_kind tyvar_names
+ SynTyDetails rhs_ty = lookupNameEnv_NF rec_details tycon_name
+ argvrcs = lookupWithDefaultFM rec_vrcs bogusVrcs tycon
+
+buildTyConOrClass is_rec kenv rec_vrcs rec_details
+ (TyData data_or_new context tycon_name tyvar_names _ nconstrs _ _ src_loc)
+ = (tycon_name, ATyCon tycon)
+ where
+ tycon = mkAlgTyCon tycon_name tycon_kind tyvars ctxt argvrcs
+ data_cons nconstrs
+ derived_classes
+ flavour is_rec
+
+ DataTyDetails ctxt data_cons derived_classes = lookupNameEnv_NF rec_details tycon_name
+
+ tycon_kind = lookupNameEnv_NF kenv tycon_name
+ tyvars = mkTyClTyVars tycon_kind tyvar_names
+ argvrcs = lookupWithDefaultFM rec_vrcs bogusVrcs tycon
+
+ flavour = case data_or_new of
+ NewType -> NewTyCon (mkNewTyConRep tycon)
+ DataType | all isNullaryDataCon data_cons -> EnumTyCon
+ | otherwise -> DataTyCon
+
+buildTyConOrClass is_rec kenv rec_vrcs rec_details
+ (ClassDecl context class_name
+ tyvar_names fundeps class_sigs def_methods pragmas
+ tycon_name datacon_name datacon_wkr_name sc_sel_names src_loc)
+ = (class_name, AClass clas)
+ where
+ clas = mkClass class_name tyvars fds
+ sc_theta sc_sel_ids op_items
+ tycon
+
+ tycon = mkClassTyCon tycon_name class_kind tyvars
+ argvrcs dict_con
+ clas -- Yes! It's a dictionary
+ flavour
+
+ ClassDetails sc_theta sc_sel_ids op_items dict_con = lookupNameEnv_NF rec_details class_name
+
+ class_kind = lookupNameEnv_NF kenv class_name
+ tyvars = mkTyClTyVars class_kind tyvar_names
+ argvrcs = lookupWithDefaultFM rec_vrcs bogusVrcs tycon
+ n_fields = length sc_sel_ids + length op_items
+
+ flavour | n_fields == 1 = NewTyCon (mkNewTyConRep tycon)
+ | otherwise = DataTyCon
+
+ -- We can find the functional dependencies right away,
+ -- and it is vital to do so. Why? Because in the next pass
+ -- we check for ambiguity in all the type signatures, and we
+ -- need the functional dependcies to be done by then
+ fds = [(map lookup xs, map lookup ys) | (xs,ys) <- fundeps]
+ tyvar_env = mkNameEnv [(varName tv, tv) | tv <- tyvars]
+ lookup = lookupNameEnv_NF tyvar_env
+
+bogusVrcs = panic "Bogus tycon arg variances"