- maybe_in_scope = lookupFM global_name_env (ieName ie)
- Just (name,_) = maybe_in_scope
- maybe_avail = lookupUFM entity_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)]
- mk_exported_fixities exports
- = fmToList (foldr (perhaps_add_fixity exports)
- emptyFM
- (fmToList fixity_env))
-
- perhaps_add_fixity :: NameSet -> (RdrName, (Fixity, HowInScope))
- -> FiniteMap OccName Fixity
- -> FiniteMap OccName Fixity
- perhaps_add_fixity exports (rdr_name, (fixity, how_in_scope)) 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 global_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 -> -- Got it already
- ASSERT( fixity == fixity1 )
- do_nothing;
- Nothing ->
-
- -- Step 3: add it to the outgoing fix_env
- addToFM fix_env occ_name fixity
- }}
-
-{- warn and weed out duplicate module entries from export list. -}
-checkForModuleExportDups :: [RdrNameIE] -> RnMG [RdrNameIE]
-checkForModuleExportDups ls
- | opt_WarnDuplicateExports = check_modules ls
- | otherwise = returnRn ls
- where
- -- NOTE: reorders the export list by moving all module-contents
- -- exports to the end (removing duplicates in the process.)
- check_modules ls =
- (case dups of
- [] -> returnRn ()
- ls -> mapRn (\ ds@(IEModuleContents x:_) ->
- addWarnRn (dupModuleExport x (length ds))) ls `thenRn_`
- returnRn ()) `thenRn_`
- returnRn (ls_no_modules ++ no_module_dups)
- where
- (ls_no_modules,modules) = foldr split_mods ([],[]) ls
-
- split_mods i@(IEModuleContents _) (no_ms,ms) = (no_ms,i:ms)
- split_mods i (no_ms,ms) = (i:no_ms,ms)
-
- (no_module_dups, dups) = removeDups cmp_mods modules
-
- cmp_mods (IEModuleContents m1) (IEModuleContents m2) = m1 `compare` m2
-
-mk_export_fn :: [AvailInfo] -> (Name -> ExportFlag)
-mk_export_fn avails
- = \name -> if name `elemNameSet` exported_names
- then Exported
- else NotExported
+ rdr_name = ieName ie
+ maybe_in_scope = lookupFM global_name_env rdr_name
+ Just ((name,prov):dup_names) = maybe_in_scope
+ maybe_avail = lookupUFM entity_avail_env name
+ Just avail = maybe_avail
+ maybe_export_avail = filterAvail ie avail
+ enough_avail = maybeToBool maybe_export_avail
+ Just export_avail = maybe_export_avail
+
+ ok_item (IEThingAll _) (AvailTC _ [n]) = False
+ -- This occurs when you import T(..), but
+ -- only export T abstractly. The single [n]
+ -- in the AvailTC is the type or class itself
+ ok_item _ _ = True
+
+check_occs :: RdrNameIE -> ExportOccMap -> AvailInfo -> RnMG ExportOccMap
+check_occs ie occs avail
+ = doptRn Opt_WarnDuplicateExports `thenRn` \ warn_dup_exports ->
+ foldlRn (check warn_dup_exports) occs (availNames avail)