-\subsection{Validity check}
-%* *
-%************************************************************************
-
-checkValidTyCon is called once the mutually-recursive knot has been
-tied, so we can look at things freely.
-
-\begin{code}
-checkValidTyCon :: TyCon -> TcM ()
-checkValidTyCon tc
- | isSynTyCon tc = checkValidType (TySynCtxt name) syn_rhs
- | otherwise
- = -- Check the context on the data decl
- checkValidTheta (DataTyCtxt name) (tyConTheta tc) `thenTc_`
-
- -- Check arg types of data constructors
- mapTc_ check_data_con data_cons `thenTc_`
-
- -- Check that fields with the same name share a type
- mapTc_ check_fields groups
-
- where
- name = tyConName tc
- (_, syn_rhs) = getSynTyConDefn tc
- data_cons = tyConDataCons tc
-
- fields = [field | con <- data_cons, field <- dataConFieldLabels con]
- groups = equivClasses cmp_name fields
- cmp_name field1 field2 = fieldLabelName field1 `compare` fieldLabelName field2
-
- check_data_con con = checkValidType (ConArgCtxt (dataConName con))
- (idType (dataConWrapId con))
- -- This checks the argument types and
- -- the existential context (if any)
-
- check_fields fields@(first_field_label : other_fields)
- -- These fields all have the same name, but are from
- -- different constructors in the data type
- = -- Check that all the fields in the group have the same type
- -- NB: this check assumes that all the constructors of a given
- -- data type use the same type variables
- checkTc (all (tcEqType field_ty) other_tys) (fieldTypeMisMatch field_name)
- where
- field_ty = fieldLabelType first_field_label
- field_name = fieldLabelName first_field_label
- other_tys = map fieldLabelType other_fields
-\end{code}
-
-
-
-%************************************************************************
-%* *