From c4d85183321cb88070d5e6a76dbc4594ebaf2f48 Mon Sep 17 00:00:00 2001 From: simonpj Date: Tue, 5 Nov 2002 11:42:49 +0000 Subject: [PATCH] [project @ 2002-11-05 11:42:48 by simonpj] ------------------ Fix module exports ------------------ GHC was doing the wrong thing when it came to detecting conflicts on exports from 'module M' items. This commit fixes it. There's a test in rename/should_fail/rnfail040 --- ghc/compiler/rename/RnNames.lhs | 89 ++++++++++++++++++++++++---------- ghc/compiler/typecheck/TcRnMonad.lhs | 2 +- ghc/compiler/typecheck/TcRnTypes.lhs | 32 +++++++----- 3 files changed, 85 insertions(+), 38 deletions(-) diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index 60044be..126ddd8 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/ghc/compiler/rename/RnNames.lhs @@ -40,10 +40,10 @@ import HscTypes ( Provenance(..), ImportReason(..), GlobalRdrEnv, Deprecations(..), ModIface(..), Dependencies(..), GlobalRdrElt(..), unQualInScope, isLocalGRE ) -import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace, - emptyRdrEnv, foldRdrEnv, isQual ) +import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace, lookupRdrEnv, + emptyRdrEnv, foldRdrEnv, mkRdrUnqual, isQual ) import Outputable -import Maybes ( maybeToBool, catMaybes ) +import Maybe ( isJust, isNothing, catMaybes ) import ListSetOps ( removeDups ) import Util ( sortLt, notNull ) import List ( partition, insert ) @@ -205,19 +205,17 @@ importsFromImportDecl this_mod -- module M ( module P ) where ... -- Then we must export whatever came from P unqualified. avail_env = mkAvailEnv filtered_avails - unqual_avails | qual_only = emptyAvailEnv -- Qualified import - | otherwise = avail_env -- Unqualified import mk_prov name = NonLocalDef (UserImport imp_mod iloc (name `elemNameSet` explicits)) gbl_env = mkGlobalRdrEnv qual_mod_name (not qual_only) mk_prov filtered_avails deprecs imports = ImportAvails { - imp_unqual = unitModuleEnvByName qual_mod_name unqual_avails, - imp_env = avail_env, - imp_mods = unitModuleEnv imp_mod (imp_mod, import_all), - imp_orphs = orphans, - imp_dep_mods = mkModDeps dependent_mods, - imp_dep_pkgs = dependent_pkgs } + imp_qual = unitModuleEnvByName qual_mod_name avail_env, + imp_env = avail_env, + imp_mods = unitModuleEnv imp_mod (imp_mod, import_all), + imp_orphs = orphans, + imp_dep_mods = mkModDeps dependent_mods, + imp_dep_pkgs = dependent_pkgs } in -- Complain if we import a deprecated module @@ -313,8 +311,8 @@ importsFromLocalDecls group avail_env = mkAvailEnv avails' imports = emptyImportAvails { - imp_unqual = unitModuleEnv this_mod avail_env, - imp_env = avail_env + imp_qual = unitModuleEnv this_mod avail_env, + imp_env = avail_env } in returnM (gbl_env, imports) @@ -441,8 +439,8 @@ filterImports mod from (Just (want_hiding, import_items)) total_avails Just avail -> returnM [(avail, availNames avail)] check_item item - | not (maybeToBool maybe_in_import_avails) || - not (maybeToBool maybe_filtered_avail) + | isNothing maybe_in_import_avails || + isNothing maybe_filtered_avail = Nothing | otherwise @@ -549,8 +547,8 @@ exportsFromAvail (Just exports) exports_from_avail exports warn_dup_exports imports } exports_from_avail export_items warn_dup_exports - (ImportAvails { imp_unqual = mod_avail_env, - imp_env = entity_avail_env }) + (ImportAvails { imp_qual = mod_avail_env, + imp_env = entity_avail_env }) = foldlM exports_from_item emptyExportAccum export_items `thenM` \ (_, _, export_avail_map) -> returnM (nameEnvElts export_avail_map) @@ -568,10 +566,20 @@ exports_from_avail export_items warn_dup_exports Nothing -> addErr (modExportErr mod) `thenM_` returnM acc Just avail_env - -> let - mod_avails = availEnvElts avail_env + -> getGlobalRdrEnv `thenM` \ global_env -> + let + mod_avails = [ filtered_avail + | avail <- availEnvElts avail_env, + let mb_avail = filter_unqual global_env avail, + isJust mb_avail, + let Just filtered_avail = mb_avail] + avails' = foldl addAvail avails mod_avails in + -- This check_occs not only finds conflicts between this item + -- 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' -> @@ -605,13 +613,32 @@ exports_from_avail export_items warn_dup_exports }}} +------------------------------- +filter_unqual :: GlobalRdrEnv -> AvailInfo -> Maybe AvailInfo +-- Filter the Avail by what's in scope unqualified +filter_unqual env (Avail n) + | in_scope env n = Just (Avail n) + | otherwise = Nothing +filter_unqual env (AvailTC n ns) + | not (null ns') = Just (AvailTC n ns') + | otherwise = Nothing + where + ns' = filter (in_scope env) 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))) + +------------------------------- 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 :: Bool -> RdrNameIE -> ExportOccMap -> AvailInfo -> TcRn m ExportOccMap check_occs warn_dup_exports ie occs avail = foldlM check occs (availNames avail) @@ -626,7 +653,7 @@ check_occs warn_dup_exports ie occs avail `thenM_` returnM occs | otherwise -> -- Same occ name but different names: an error - addErr (exportClashErr name_occ ie ie') `thenM_` + addErr (exportClashErr name name' ie ie') `thenM_` returnM occs where name_occ = nameOccName name @@ -735,7 +762,7 @@ reportUnusedNames gbl_env used_names -- [Note: not 'minimal_imports', because that includes direcly-imported -- modules even if we use nothing from them; see notes above] unused_imp_mods = [m | m <- direct_import_mods, - not (maybeToBool (lookupFM minimal_imports1 m)), + isNothing (lookupFM minimal_imports1 m), m /= pRELUDE_Name] module_unused :: Module -> Bool @@ -822,10 +849,22 @@ 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 occ_name ie1 ie2 - = hsep [ptext SLIT("The export items"), quotes (ppr ie1) - ,ptext SLIT("and"), quotes (ppr ie2) - ,ptext SLIT("create conflicting exports for"), quotes (ppr occ_name)] +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 ] + 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 dupDeclErr (n:ns) = vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n), diff --git a/ghc/compiler/typecheck/TcRnMonad.lhs b/ghc/compiler/typecheck/TcRnMonad.lhs index 22eae1b..8233c06 100644 --- a/ghc/compiler/typecheck/TcRnMonad.lhs +++ b/ghc/compiler/typecheck/TcRnMonad.lhs @@ -177,7 +177,7 @@ initTc (HscEnv { hsc_mode = ghci_mode, where eps = pcs_EPS pcs - init_imports = emptyImportAvails { imp_unqual = unitModuleEnv mod emptyAvailEnv } + init_imports = emptyImportAvails { imp_qual = unitModuleEnv mod emptyAvailEnv } -- Initialise tcg_imports with an empty set of bindings for -- this module, so that if we see 'module M' in the export -- list, and there are no bindings in M, we don't bleat diff --git a/ghc/compiler/typecheck/TcRnTypes.lhs b/ghc/compiler/typecheck/TcRnTypes.lhs index e81813e..10f6d44 100644 --- a/ghc/compiler/typecheck/TcRnTypes.lhs +++ b/ghc/compiler/typecheck/TcRnTypes.lhs @@ -463,10 +463,18 @@ data ImportAvails -- i.e. *excluding* class ops and constructors -- (which appear inside their parent AvailTC) - imp_unqual :: ModuleEnv AvailEnv, + imp_qual :: ModuleEnv AvailEnv, -- Used to figure out "module M" export specifiers - -- Domain is only modules with *unqualified* imports - -- (see 1.4 Report Section 5.1.1) + -- (see 1.4 Report Section 5.1.1). Ultimately, we want to find + -- everything that is unambiguously in scope as 'M.x' + -- and where plain 'x' is (perhaps ambiguously) in scope. + -- So the starting point is all things that are in scope as 'M.x', + -- which is what this field tells us. + -- + -- Domain is the *module qualifier* for imports. + -- e.g. import List as Foo + -- would add a binding Foo |-> ...stuff from List... + -- to imp_qual. -- We keep the stuff as an AvailEnv so that it's easy to -- combine stuff coming from different (unqualified) -- imports of the same module @@ -503,7 +511,7 @@ data ImportAvails emptyImportAvails :: ImportAvails emptyImportAvails = ImportAvails { imp_env = emptyAvailEnv, - imp_unqual = emptyModuleEnv, + imp_qual = emptyModuleEnv, imp_mods = emptyModuleEnv, imp_dep_mods = emptyModuleEnv, imp_dep_pkgs = [], @@ -511,16 +519,16 @@ emptyImportAvails = ImportAvails { imp_env = emptyAvailEnv, plusImportAvails :: ImportAvails -> ImportAvails -> ImportAvails plusImportAvails - (ImportAvails { imp_env = env1, imp_unqual = unqual1, imp_mods = mods1, + (ImportAvails { imp_env = env1, imp_qual = unqual1, imp_mods = mods1, imp_dep_mods = dmods1, imp_dep_pkgs = dpkgs1, imp_orphs = orphs1 }) - (ImportAvails { imp_env = env2, imp_unqual = unqual2, imp_mods = mods2, + (ImportAvails { imp_env = env2, imp_qual = unqual2, imp_mods = mods2, imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2, imp_orphs = orphs2 }) - = ImportAvails { imp_env = env1 `plusAvailEnv` env2, - imp_unqual = plusModuleEnv_C plusAvailEnv unqual1 unqual2, - imp_mods = mods1 `plusModuleEnv` mods2, - imp_dep_mods = plusModuleEnv_C plus_mod_dep dmods1 dmods2, - imp_dep_pkgs = dpkgs1 `unionLists` dpkgs2, - imp_orphs = orphs1 `unionLists` orphs2 } + = ImportAvails { imp_env = env1 `plusAvailEnv` env2, + imp_qual = plusModuleEnv_C plusAvailEnv unqual1 unqual2, + imp_mods = mods1 `plusModuleEnv` mods2, + imp_dep_mods = plusModuleEnv_C plus_mod_dep dmods1 dmods2, + imp_dep_pkgs = dpkgs1 `unionLists` dpkgs2, + imp_orphs = orphs1 `unionLists` orphs2 } where plus_mod_dep (m1, boot1) (m2, boot2) = WARN( not (m1 == m2), (ppr m1 <+> ppr m2) $$ (ppr boot1 <+> ppr boot2) ) -- 1.7.10.4