- mname = make_mid mi_module
-{- exports = foldr (collect_exports md_types) ([],[],[]) all_avails
- all_avails = concat (map snd (filter ((== moduleName mi_module) . fst) mi_exports))
--}
- tdefs = foldr collect_tdefs [] (typeEnvTyCons md_types)
- vdefs = map make_vdef md_binds
-
-{-
-collect_exports :: TypeEnv -> AvailInfo -> ([C.Tcon],[C.Dcon],[C.Var]) -> ([C.Tcon],[C.Dcon],[C.Var])
-collect_exports tyenv (Avail n) (tcons,dcons,vars) = (tcons,dcons,make_var_id n:vars)
-collect_exports tyenv (AvailTC n ns) (tcons,dcons,vars) =
- case lookupNameEnv_NF tyenv n of
- ATyCon tc | isAlgTyCon tc ->
- (tcon ++ tcons,workers ++ dcons,wrappers ++ vars)
- where
- tcon = if elem n ns then [make_con_id n] else []
- workers = if isNewTyCon tc then []
- else map (make_con_id . idName . dataConId) exported_dcs
- exported_dcs = filter (\dc -> elem ((idName . dataConWrapId) dc) ns') dcs
- dcs = tyConDataConsIfAvailable tc
- wrappers = map make_var_id ns'
- ns' = filter (\n' -> n' /= n && not (elem n' recordSels)) ns
- recordSels = map idName (tyConSelIds tc)
- AClass cl -> {- maybe a little too free about exports -}
- (tcon : tcons,workers ++ dcons,wrappers ++ vars)
- where
- tcon = make_con_id (tyConName tc)
- workers = if isNewTyCon tc then []
- else map (make_con_id . idName . dataConId) dcs
- wrappers = map (make_var_id . idName . dataConWrapId) dcs
- dcs = tyConDataConsIfAvailable tc
- tc = classTyCon cl
- _ -> (tcons,dcons,vars)
--}
+ mname = make_mid this_mod
+ tdefs = foldr collect_tdefs [] tycons
+
+ all_binds = implicit_con_wrappers ++ other_implicit_binds ++ binds
+ -- Put the constructor wrappers first, because
+ -- other implicit bindings (notably the fromT functions arising
+ -- from generics) use the constructor wrappers.
+
+ tycons = map classTyCon (typeEnvClasses type_env) ++ typeEnvTyCons type_env
+
+ implicit_con_wrappers = map get_defn (concatMap implicit_con_ids (typeEnvElts type_env))
+ other_implicit_binds = map get_defn (concatMap other_implicit_ids (typeEnvElts type_env))
+
+implicit_con_ids :: TyThing -> [Id]
+implicit_con_ids (ATyCon tc) | isAlgTyCon tc = mapCatMaybes dataConWrapId_maybe (tyConDataCons tc)
+implicit_con_ids other = []