-gen_tag_n_con_binds :: GlobalNameMappers
- -> [(ProtoName, Name, TyCon, TagThingWanted)]
- -> TcM s RenamedHsBinds
-
-gen_tag_n_con_binds deriver_name_funs nm_alist_etc
- = let
- proto_mbind_list = map gen_tag_n_con_monobind nm_alist_etc
- proto_mbinds = foldr AndMonoBinds EmptyMonoBinds proto_mbind_list
+gen_tag_n_con_binds :: RnEnv
+ -> [(RdrName, TyCon, TagThingWanted)]
+ -> TcM s (RenamedHsBinds,
+ RnEnv) -- input one with any new names added
+
+gen_tag_n_con_binds rn_env nm_alist_etc
+ =
+ let
+ -- We have the renamer's final "name funs" in our hands
+ -- (they were passed in). So we can handle ProtoNames
+ -- that refer to anything "out there". But our generated
+ -- code may also mention "con2tag" (etc.). So we need
+ -- to augment to "name funs" to include those.
+
+ names_to_add = [ pn | (pn,_,_) <- nm_alist_etc ]
+ in
+ tcGetUniques (length names_to_add) `thenNF_Tc` \ uniqs ->
+ let
+ pairs_to_add = [ case pn of { Qual pnm pnn ->
+ (pn, mkRnName (mkTopLevName u (OrigName pnm pnn) mkGeneratedSrcLoc ExportAll [])) }
+ | (pn,u) <- zipEqual "gen_tag..." names_to_add uniqs ]
+
+ deriver_rn_env
+ = if null names_to_add
+ then rn_env else added_rn_env
+
+ (added_rn_env, errs_bag)
+ = extendGlobalRnEnv rn_env pairs_to_add [{-no tycons-}]
+
+ ----------------
+ proto_mbind_list = map gen_tag_n_con_monobind nm_alist_etc
+ proto_mbinds = foldr AndMonoBinds EmptyMonoBinds proto_mbind_list