IMP_Ubiq()
-import CmdLineOpts ( opt_SourceUnchanged, opt_NoImplicitPrelude )
+import CmdLineOpts ( opt_SourceUnchanged, opt_NoImplicitPrelude,
+ opt_WarnDuplicateExports
+ )
import HsSyn ( HsModule(..), HsDecl(..), FixityDecl(..), Fixity, Fake, InPat, IE(..), HsTyVar,
TyDecl, ClassDecl, InstDecl, DefaultDecl, ImportDecl(..), HsBinds, IfaceSig,
collectTopBinders
import BasicTypes ( IfaceFlavour(..) )
import RnEnv
import RnMonad
+
import FiniteMap
import PrelMods
import UniqFM ( UniqFM, emptyUFM, addListToUFM_C, lookupUFM )
import Name
import Pretty
import Outputable ( Outputable(..), PprStyle(..) )
-import Util ( panic, pprTrace, assertPanic )
+import Util ( panic, pprTrace, assertPanic, removeDups, cmpPString )
\end{code}
[AvailInfo]) -- What was imported explicitly
-- Complains if import spec mentions things that the module doesn't export
-
+ -- Warns/informs if import spec contains duplicates.
filterImports mod Nothing imports
= returnRn (imports, [], [])
is: two exported things must have different @OccNames@.
\begin{code}
-type AvailEnv = FiniteMap OccName (RdrNameIE, AvailInfo)
+type AvailEnv = FiniteMap OccName (RdrNameIE, AvailInfo, Int{-no. of clashes-})
-- The FM maps each OccName to the RdrNameIE that gave rise to it,
-- for error reporting, as well as to its AvailInfo
emptyAvailEnv = emptyFM
-unitAvailEnv :: RdrNameIE -> AvailInfo -> AvailEnv
-unitAvailEnv ie NotAvailable = emptyFM
-unitAvailEnv ie (AvailTC _ []) = emptyFM
-unitAvailEnv ie avail = unitFM (nameOccName (availName avail)) (ie,avail)
+{-
+ Add new entry to environment. Checks for name clashes, i.e.,
+ plain duplicates or exported entity pairs that have different OccNames.
+ (c.f. 5.1.1 of Haskell 1.4 report.)
+-}
+addAvailEnv ie env NotAvailable = returnRn env
+addAvailEnv ie env (AvailTC _ []) = returnRn env
+addAvailEnv ie env avail
+ = mapMaybeRn (addErrRn . availClashErr) () conflict `thenRn_`
+ returnRn (addToFM_C add_avail env key elt)
+ where
+ key = nameOccName (availName avail)
+ elt = (ie,avail,reports_on)
+
+ reports_on
+ | maybeToBool dup = 1
+ | otherwise = 0
+
+ conflict = conflictFM bad_avail env key elt
+ dup
+ | opt_WarnDuplicateExports = conflictFM dup_avail env key elt
+ | otherwise = Nothing
-plusAvailEnv a1 a2
- = mapRn (addErrRn.availClashErr) (conflictsFM bad_avail a1 a2) `thenRn_`
- returnRn (plusFM_C plus_avail a1 a2)
+addListToAvailEnv :: AvailEnv -> RdrNameIE -> [AvailInfo] -> RnM s d AvailEnv
+addListToAvailEnv env ie items = foldlRn (addAvailEnv ie) env items
-listToAvailEnv :: RdrNameIE -> [AvailInfo] -> RnM s d AvailEnv
-listToAvailEnv ie items
- = foldlRn plusAvailEnv emptyAvailEnv (map (unitAvailEnv ie) items)
+bad_avail (ie1,avail1,r1) (ie2,avail2,r2)
+ = availName avail1 /= availName avail2 -- Same OccName, different Name
+dup_avail (ie1,avail1,r1) (ie2,avail2,r2)
+ = availName avail1 == availName avail2 -- Same OccName & avail.
+
+add_avail (ie1,a1,r1) (ie2,a2,r2) = (ie1, a1 `plusAvail` a2, r1 + r2)
-bad_avail (ie1,avail1) (ie2,avail2) = availName avail1 /= availName avail2 -- Same OccName, different Name
-plus_avail (ie1,a1) (ie2,a2) = (ie1, a1 `plusAvail` a2)
\end{code}
Processing the export list.
-> RnEnv
-> RnMG (Name -> ExportFlag, ExportEnv)
-- Complains if two distinct exports have same OccName
+ -- Warns about identical exports.
-- Complains about exports items not in scope
exportsFromAvail this_mod Nothing export_avails rn_env
= exportsFromAvail this_mod (Just [IEModuleContents this_mod]) export_avails rn_env
exportsFromAvail this_mod (Just export_items)
(mod_avail_env, entity_avail_env)
(RnEnv name_env fixity_env)
- = mapRn exports_from_item export_items `thenRn` \ avail_envs ->
- foldlRn plusAvailEnv emptyAvailEnv avail_envs `thenRn` \ export_avail_env ->
+ = checkForModuleExportDups export_items `thenRn` \ export_items' ->
+ foldlRn exports_from_item emptyAvailEnv export_items' `thenRn` \ export_avail_env ->
+ let
+ dup_entries = fmToList (filterFM (\ _ (_,_,clashes) -> clashes > 0) export_avail_env)
+ in
+ mapRn (addWarnRn . dupExportWarn) dup_entries `thenRn_`
let
- export_avails = map snd (eltsFM export_avail_env)
+ export_avails = map (\ (_,a,_) -> a) (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
- exports_from_item :: RdrNameIE -> RnMG AvailEnv
- exports_from_item ie@(IEModuleContents mod)
+ exports_from_item :: AvailEnv -> RdrNameIE -> RnMG AvailEnv
+ exports_from_item export_avail_env ie@(IEModuleContents mod)
= case lookupFM mod_avail_env mod of
- Nothing -> failWithRn emptyAvailEnv (modExportErr mod)
- Just avails -> listToAvailEnv ie avails
+ Nothing -> failWithRn export_avail_env (modExportErr mod)
+ Just avails -> addListToAvailEnv export_avail_env ie avails
- exports_from_item ie
+ exports_from_item export_avail_env ie
| not (maybeToBool maybe_in_scope)
- = failWithRn emptyAvailEnv (unknownNameErr (ieName ie))
+ = failWithRn export_avail_env (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
+ returnRn export_avail_env
#endif
| not enough_avail
- = failWithRn emptyAvailEnv (exportItemErr ie export_avail)
+ = failWithRn export_avail_env (exportItemErr ie export_avail)
| otherwise -- Phew! It's OK!
- = returnRn (unitAvailEnv ie export_avail)
+ = addAvailEnv ie export_avail_env export_avail
where
maybe_in_scope = lookupNameEnv name_env (ieName ie)
Just name = maybe_in_scope
addToFM fix_env occ_name (fixity,prov)
}}
+{- 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 `cmpPString` m2
+
mk_export_fn :: [AvailInfo] -> (Name -> ExportFlag)
mk_export_fn avails
= \name -> if name `elemNameSet` exported_names
where
exported_names :: NameSet
exported_names = availsToNameSet avails
-\end{code}
-
+\end{code}
%************************************************************************
%* *
4 (vcat [hsep [ptext SLIT("Wanted: "), ppr sty export_item],
hsep [ptext SLIT("Available:"), ppr sty (ieOcc export_item), pprAvail sty avail]])
-availClashErr (occ_name, ((ie1,avail1), (ie2,avail2))) sty
+availClashErr (occ_name, ((ie1,avail1,_), (ie2,avail2,_))) sty
= hsep [ptext SLIT("The export items"), ppr sty ie1, ptext SLIT("and"), ppr sty ie2,
ptext SLIT("create conflicting exports for"), ppr sty occ_name]
+
+dupExportWarn (occ_name, (_,_,times)) sty
+ = hsep [ppr sty occ_name,
+ ptext SLIT("mentioned"), text (speak_times (times+1)),
+ ptext SLIT("in export list")]
+
+dupModuleExport mod times sty
+ = hsep [ptext SLIT("Module"), pprModule sty mod,
+ ptext SLIT("mentioned"), text (speak_times times),
+ ptext SLIT("in export list")]
+
+speak_times :: Int{- >=1 -} -> String
+speak_times t | t == 1 = "once"
+ | t == 2 = "twice"
+ | otherwise = show t ++ " times"
+
+
\end{code}
projects / ghc-hetmet.git / commitdiff