+exportsFromAvail :: Module
+ -> Maybe [RdrNameIE] -- Export spec
+ -> ModuleAvails
+ -> RnEnv
+ -> RnMG (Name -> ExportFlag, ExportEnv)
+ -- Complains if two distinct exports have same OccName
+ -- Complains about exports items not in scope
+exportsFromAvail this_mod Nothing all_avails rn_env
+ = exportsFromAvail this_mod (Just [IEModuleContents this_mod]) all_avails rn_env
+
+exportsFromAvail this_mod (Just export_items) all_avails (RnEnv name_env fixity_env)
+ = mapRn exports_from_item export_items `thenRn` \ avail_envs ->
+ foldlRn plusAvailEnv emptyAvailEnv avail_envs `thenRn` \ export_avail_env ->
+ let
+ export_avails = map snd (eltsFM export_avail_env)
+ export_fixities = mk_exported_fixities (availsToNameSet export_avails)
+ export_fn = mk_export_fn export_avails
+ in
+ returnRn (export_fn, ExportEnv export_avails export_fixities)
+
+ where
+ full_avail_env :: UniqFM AvailInfo
+ full_avail_env = addListToUFM_C plusAvail emptyUFM
+ [(name,avail) | avail@(Avail name _) <- concat (eltsFM all_avails)]
+ -- NB: full_avail_env won't contain bindings for data constructors and class ops,
+ -- which is right and proper; attempts to export them on their own will provoke an error
+
+ exports_from_item :: RdrNameIE -> RnMG AvailEnv
+ exports_from_item ie@(IEModuleContents mod)
+ = case lookupFM all_avails mod of
+ Nothing -> failWithRn emptyAvailEnv (modExportErr mod)
+ Just avails -> addOccurrenceNames Compulsory [n | Avail n _ <- avails] `thenRn_`
+ listToAvailEnv ie avails
+
+ exports_from_item ie
+ | not (maybeToBool maybe_in_scope)
+ = failWithRn emptyAvailEnv (unknownNameErr (ieName ie))
+
+#ifdef DEBUG
+ -- I can't see why this should ever happen; if the thing is in scope
+ -- at all it ought to have some availability
+ | not (maybeToBool maybe_avail)
+ = pprTrace "exportsFromAvail: curious Nothing:" (ppr PprDebug name)
+ returnRn emptyAvailEnv
+#endif
+
+ | not enough_avail
+ = failWithRn emptyAvailEnv (exportItemErr ie export_avail)
+
+ | otherwise -- Phew! It's OK!
+ = addOccurrenceName Compulsory name `thenRn_`
+ returnRn (unitAvailEnv ie export_avail)
+ where
+ maybe_in_scope = lookupNameEnv name_env (ieName ie)
+ Just name = maybe_in_scope
+ maybe_avail = lookupUFM full_avail_env name
+ Just avail = maybe_avail
+ export_avail = filterAvail ie avail
+ enough_avail = case export_avail of {NotAvailable -> False; other -> True}
+
+ -- We export a fixity iff we export a thing with the same (qualified) RdrName
+ mk_exported_fixities :: NameSet -> [(OccName, (Fixity, Provenance))]
+ mk_exported_fixities exports
+ = fmToList (foldr (perhaps_add_fixity exports)
+ emptyFM
+ (fmToList fixity_env))
+
+ perhaps_add_fixity :: NameSet -> (RdrName, (Fixity, Provenance))
+ -> FiniteMap OccName (Fixity,Provenance)
+ -> FiniteMap OccName (Fixity,Provenance)
+ perhaps_add_fixity exports (rdr_name, (fixity, prov)) fix_env
+ = let
+ do_nothing = fix_env -- The default is to pass on the env unchanged
+ in
+ -- Step 1: check whether the rdr_name is in scope; if so find its Name
+ case lookupFM name_env rdr_name of {
+ Nothing -> do_nothing;
+ Just fixity_name ->
+
+ -- Step 2: check whether the fixity thing is exported
+ if not (fixity_name `elemNameSet` exports) then
+ do_nothing
+ else
+
+ -- Step 3: check whether we already have a fixity for the
+ -- Name's OccName in the fix_env we are building up. This can easily
+ -- happen. the original fixity_env might contain bindings for
+ -- M.a and N.a, if a was imported via M and N.
+ -- If this does happen, we expect the fixity to be the same either way.
+ let
+ occ_name = rdrNameOcc rdr_name
+ in
+ case lookupFM fix_env occ_name of {
+ Just (fixity1, prov1) -> -- Got it already
+ ASSERT( fixity == fixity1 )
+ do_nothing;
+ Nothing ->
+
+ -- Step 3: add it to the outgoing fix_env
+ addToFM fix_env occ_name (fixity,prov)
+ }}
+
+mk_export_fn :: [AvailInfo] -> (Name -> ExportFlag)
+mk_export_fn avails
+ = \name -> if name `elemNameSet` exported_names
+ then Exported
+ else NotExported