-\begin{code}
-mkImplicitDataBinds :: Module -> [TyCon] -> TcM ([Id], TcMonoBinds)
-mkImplicitDataBinds this_mod [] = returnTc ([], EmptyMonoBinds)
-mkImplicitDataBinds this_mod (tycon : tycons)
- | isSynTyCon tycon = mkImplicitDataBinds this_mod tycons
- | otherwise = mkImplicitDataBinds_one this_mod tycon `thenTc` \ (ids1, b1) ->
- mkImplicitDataBinds this_mod tycons `thenTc` \ (ids2, b2) ->
- returnTc (ids1++ids2, b1 `AndMonoBinds` b2)
-
-mkImplicitDataBinds_one this_mod tycon
- = mapTc (mkRecordSelector tycon) groups `thenTc` \ sel_ids ->
- let
- unf_ids = sel_ids ++ data_con_wrapper_ids ++ gen_ids
- all_ids = map dataConId data_cons ++ unf_ids
-
- -- For the locally-defined things
- -- we need to turn the unfoldings inside the selector Ids into bindings,
- -- and build bindigns for the constructor wrappers
- binds | isFrom this_mod tycon = idsToMonoBinds unf_ids
- | otherwise = EmptyMonoBinds
- in
- returnTc (all_ids, binds)
- where
- data_cons = tyConDataConsIfAvailable tycon
- -- Abstract types mean we don't bring the
- -- data cons into scope, which should be fine
- gen_ids = tyConGenIds tycon
- data_con_wrapper_ids = map dataConWrapId data_cons
-
- fields = [ (con, 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
-\end{code}