From 8f0c89cbbbad60c4f05356fcb9053b7ed0c18075 Mon Sep 17 00:00:00 2001 From: simonpj Date: Wed, 6 Nov 2002 12:49:51 +0000 Subject: [PATCH] [project @ 2002-11-06 12:49:47 by simonpj] More wibbles to do with export lists --- ghc/compiler/main/HscTypes.lhs | 2 +- ghc/compiler/rename/RnNames.lhs | 87 +++++++++++++++++++++------------------ 2 files changed, 49 insertions(+), 40 deletions(-) diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index fdd66c7..4214c69 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -972,6 +972,6 @@ pprNameProvenance (GRE {gre_name = name, gre_prov = prov}) ppr_reason ImplicitImport = ptext SLIT("implicitly imported") ppr_reason (UserImport mod loc _) = ptext SLIT("imported from") <+> ppr mod <+> ptext SLIT("at") <+> ppr loc -ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("at") <+> ppr loc) +ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("defined at") <+> ppr loc) | otherwise = empty \end{code} diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index 126ddd8..21c3546 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/ghc/compiler/rename/RnNames.lhs @@ -38,10 +38,10 @@ import HscTypes ( Provenance(..), ImportReason(..), GlobalRdrEnv, IsBootInterface, availName, availNames, availsToNameSet, Deprecations(..), ModIface(..), Dependencies(..), - GlobalRdrElt(..), unQualInScope, isLocalGRE + GlobalRdrElt(..), unQualInScope, isLocalGRE, pprNameProvenance ) import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace, lookupRdrEnv, - emptyRdrEnv, foldRdrEnv, mkRdrUnqual, isQual ) + emptyRdrEnv, foldRdrEnv, rdrEnvElts, mkRdrUnqual, isQual ) import Outputable import Maybe ( isJust, isNothing, catMaybes ) import ListSetOps ( removeDups ) @@ -543,10 +543,9 @@ exportsFromAvail Nothing exportsFromAvail (Just exports) = do { TcGblEnv { tcg_imports = imports } <- getGblEnv ; - warn_dup_exports <- doptM Opt_WarnDuplicateExports ; - exports_from_avail exports warn_dup_exports imports } + exports_from_avail exports imports } -exports_from_avail export_items warn_dup_exports +exports_from_avail export_items (ImportAvails { imp_qual = mod_avail_env, imp_env = entity_avail_env }) = foldlM exports_from_item emptyExportAccum @@ -558,13 +557,15 @@ exports_from_avail export_items warn_dup_exports exports_from_item acc@(mods, occs, avails) ie@(IEModuleContents mod) | mod `elem` mods -- Duplicate export of M - = warnIf warn_dup_exports (dupModuleExport mod) `thenM_` - returnM acc + = do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ; + warnIf warn_dup_exports (dupModuleExport mod) ; + returnM acc } | otherwise = case lookupModuleEnvByName mod_avail_env mod of - Nothing -> addErr (modExportErr mod) `thenM_` - returnM acc + Nothing -> addErr (modExportErr mod) `thenM_` + returnM acc + Just avail_env -> getGlobalRdrEnv `thenM` \ global_env -> let @@ -580,9 +581,8 @@ exports_from_avail export_items warn_dup_exports -- and others, but also internally within this item. That is, -- if 'M.x' is in scope in several ways, we'll have several -- members of mod_avails with the same OccName. - foldlM (check_occs warn_dup_exports ie) - occs mod_avails `thenM` \ occs' -> + foldlM (check_occs ie) occs mod_avails `thenM` \ occs' -> returnM (mod:mods, occs', avails') exports_from_item acc@(mods, occs, avails) ie @@ -608,7 +608,7 @@ exports_from_avail export_items warn_dup_exports -- Phew! It's OK! Now to check the occurrence stuff! warnIf (not (ok_item ie avail)) (dodgyExportWarn ie) `thenM_` - check_occs warn_dup_exports ie occs export_avail `thenM` \ occs' -> + check_occs ie occs export_avail `thenM` \ occs' -> returnM (mods, occs', addAvail avails export_avail) }}} @@ -628,7 +628,10 @@ filter_unqual env (AvailTC n ns) in_scope :: GlobalRdrEnv -> Name -> Bool -- Checks whether the Name is in scope unqualified, -- regardless of whether it's ambiguous or not -in_scope env n = isJust (lookupRdrEnv env (mkRdrUnqual (nameOccName n))) +in_scope env n + = case lookupRdrEnv env (mkRdrUnqual (nameOccName n)) of + Nothing -> False + Just gres -> or [n == gre_name g | g <- gres] ------------------------------- @@ -639,22 +642,24 @@ ok_item (IEThingAll _) (AvailTC _ [n]) = False ok_item _ _ = True ------------------------------- -check_occs :: Bool -> RdrNameIE -> ExportOccMap -> AvailInfo -> TcRn m ExportOccMap -check_occs warn_dup_exports ie occs avail +check_occs :: RdrNameIE -> ExportOccMap -> AvailInfo -> TcRn m ExportOccMap +check_occs ie occs avail = foldlM check occs (availNames avail) where check occs name = case lookupFM occs name_occ of - Nothing -> returnM (addToFM occs name_occ (name, ie)) + Nothing -> returnM (addToFM occs name_occ (name, ie)) + Just (name', ie') - | name == name' -> -- Duplicate export - warnIf warn_dup_exports - (dupExportWarn name_occ ie ie') - `thenM_` returnM occs - - | otherwise -> -- Same occ name but different names: an error - addErr (exportClashErr name name' ie ie') `thenM_` - returnM occs + | name == name' -- Duplicate export + -> do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ; + warnIf warn_dup_exports (dupExportWarn name_occ ie ie') ; + returnM occs } + + | otherwise -- Same occ name but different names: an error + -> do { global_env <- getGlobalRdrEnv ; + addErr (exportClashErr global_env name name' ie ie') ; + returnM occs } where name_occ = nameOccName name \end{code} @@ -849,22 +854,26 @@ exportItemErr export_item = sep [ ptext SLIT("The export item") <+> quotes (ppr export_item), ptext SLIT("attempts to export constructors or class methods that are not visible here") ] -exportClashErr name1 name2 ie1 ie2 - | different_items - = sep [ ptext SLIT("The export items") <+> quotes (ppr ie1) - <+> ptext SLIT("and") <+> quotes (ppr ie2) - , ptext SLIT("create") <+> name_msg <+> ptext SLIT("respectively") ] - | otherwise - = sep [ ptext SLIT("The export item") <+> quotes (ppr ie1) - , ptext SLIT("creates") <+> name_msg ] +exportClashErr global_env name1 name2 ie1 ie2 + = vcat [ ptext SLIT("Conflicting exports for") <+> quotes (ppr occ) <> colon + , ppr_export ie1 name1 + , ppr_export ie2 name2 ] where - name_msg = ptext SLIT("conflicting exports for") <+> quotes (ppr name1) - <+> ptext SLIT("and") <+> quotes (ppr name2) - different_items -- This only comes into play when we have a single - -- 'module M' export item which gives rise to conflicts - = case (ie1,ie2) of - (IEModuleContents m1, IEModuleContents m2) -> m1 /= m2 - other -> True + occ = nameOccName name1 + ppr_export ie name = nest 2 (quotes (ppr ie) <+> ptext SLIT("exports") <+> + quotes (ppr name) <+> pprNameProvenance (get_gre name)) + + -- get_gre finds a GRE for the Name, in a very inefficient way + -- There isn't a more efficient way to do it, because we don't necessarily + -- know the RdrName under which this Name is in scope. So we just + -- search linearly. Shouldn't matter because this only happens + -- in an error message. + get_gre name + = case [gre | gres <- rdrEnvElts global_env, + gre <- gres, + gre_name gre == name] of + (gre:_) -> gre + [] -> pprPanic "exportClashErr" (ppr name) dupDeclErr (n:ns) = vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n), -- 1.7.10.4