-
-getBangStrictness (Banged _) = markedStrict
-getBangStrictness (Unbanged _) = notMarkedStrict
-getBangStrictness (Unpacked _) = markedUnboxed
-\end{code}
-
-
-%************************************************************************
-%* *
-\subsection{Record selectors}
-%* *
-%************************************************************************
-
-\begin{code}
-tcRecordSelectors is_rec unf_env tycon data_cons
- -- Omit the check that the fields have consistent types if
- -- the group is recursive; TcTyClsDecls.tcGroup will repeat
- -- with NonRecursive once we have tied the knot
- | isRec is_rec = returnTc sel_ids
- | otherwise = mapTc check groups `thenTc_`
- returnTc sel_ids
- where
- fields = [ field | con <- data_cons
- , field <- dataConFieldLabels con ]
-
- -- groups is list of fields that share a common name
- groups = equivClasses cmp_name fields
- cmp_name field1 field2 = fieldLabelName field1 `compare` fieldLabelName field2
-
- sel_ids = [ mkRecordSelId tycon field unpack_id unpackUtf8_id
- | (field : _) <- groups ]
-
- check 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 (== 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
-
- unpack_id = tcLookupRecId unf_env unpackCStringName
- unpackUtf8_id = tcLookupRecId unf_env unpackCStringUtf8Name