From 6d1815b09469c68c9d15b253745876403c7fb084 Mon Sep 17 00:00:00 2001 From: simonpj Date: Thu, 12 Jul 2001 14:51:28 +0000 Subject: [PATCH] [project @ 2001-07-12 14:51:28 by simonpj] Fix the module import story to match what the Revised Haskell Report says 1. Don't import qualified names of things that aren't imported 2. Fix a bug that meant import A hiding( D ) where D is a data constructor, didn't work. [The fix is to use IEVar not IEThingAbs in the want_hiding case of get_item in RnNames.filterImports --- ghc/compiler/basicTypes/RdrName.lhs | 11 ++++--- ghc/compiler/rename/RnEnv.lhs | 59 +++++++++++++++++++++-------------- ghc/compiler/rename/RnNames.lhs | 16 +++++----- 3 files changed, 50 insertions(+), 36 deletions(-) diff --git a/ghc/compiler/basicTypes/RdrName.lhs b/ghc/compiler/basicTypes/RdrName.lhs index a6d7a2c..7ad104e 100644 --- a/ghc/compiler/basicTypes/RdrName.lhs +++ b/ghc/compiler/basicTypes/RdrName.lhs @@ -11,7 +11,7 @@ module RdrName ( -- Construction mkRdrUnqual, mkRdrQual, mkRdrOrig, mkRdrUnqual, mkUnqual, mkQual, mkIfaceOrig, mkOrig, - qualifyRdrName, mkRdrNameWkr, + qualifyRdrName, unqualifyRdrName, mkRdrNameWkr, dummyRdrVarName, dummyRdrTcName, -- Destruction @@ -21,7 +21,7 @@ module RdrName ( -- Environment RdrNameEnv, emptyRdrEnv, lookupRdrEnv, addListToRdrEnv, rdrEnvElts, - extendRdrEnv, rdrEnvToList, elemRdrEnv, foldRdrEnv, + extendRdrEnv, rdrEnvToList, elemRdrEnv, foldRdrEnv, -- Printing; instance Outputable RdrName pprUnqualRdrName @@ -113,6 +113,9 @@ qualifyRdrName :: ModuleName -> RdrName -> RdrName -- Sets the module name of a RdrName, even if it has one already qualifyRdrName mod (RdrName _ occ) = RdrName (Qual mod) occ +unqualifyRdrName :: RdrName -> RdrName +unqualifyRdrName (RdrName _ occ) = RdrName Unqual occ + mkRdrNameWkr :: RdrName -> RdrName -- Worker-ify it mkRdrNameWkr (RdrName qual occ) = RdrName qual (mkWorkerOcc occ) \end{code} @@ -201,8 +204,8 @@ rdrEnvElts :: RdrNameEnv a -> [a] elemRdrEnv :: RdrName -> RdrNameEnv a -> Bool foldRdrEnv :: (RdrName -> a -> b -> b) -> b -> RdrNameEnv a -> b -emptyRdrEnv = emptyFM -lookupRdrEnv = lookupFM +emptyRdrEnv = emptyFM +lookupRdrEnv = lookupFM addListToRdrEnv = addListToFM rdrEnvElts = eltsFM extendRdrEnv = addToFM diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index d7167ad..a83890d 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -13,7 +13,8 @@ import {-# SOURCE #-} RnHiFiles import HsSyn import RdrHsSyn ( RdrNameIE ) import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig, - mkRdrUnqual, mkRdrQual, lookupRdrEnv, foldRdrEnv + mkRdrUnqual, mkRdrQual, lookupRdrEnv, foldRdrEnv, rdrEnvToList, + unqualifyRdrName ) import HsTypes ( hsTyVarName, replaceTyVarName ) import HscTypes ( Provenance(..), pprNameProvenance, hasBetterProv, @@ -640,48 +641,58 @@ checkDupNames doc_str rdr_names_w_loc \begin{code} mkGlobalRdrEnv :: ModuleName -- Imported module (after doing the "as M" name change) -> Bool -- True <=> want unqualified import - -> Bool -- True <=> want qualified import - -> [AvailInfo] -- What's to be hidden (but only the unqualified - -- version is hidden) -> (Name -> Provenance) - -> Avails -- Whats imported and how + -> Avails -- Whats imported + -> Avails -- What's to be hidden + -- I.e. import (imports - hides) -> Deprecations -> GlobalRdrEnv -mkGlobalRdrEnv this_mod unqual_imp qual_imp hides - mk_provenance avails deprecs - = gbl_env2 +mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails hides deprecs + = gbl_env3 where -- Make the name environment. We're talking about a -- single module here, so there must be no name clashes. -- In practice there only ever will be if it's the module -- being compiled. - -- Add the things that are available + -- Add qualified names for the things that are available + -- (Qualified names are always imported) gbl_env1 = foldl add_avail emptyRdrEnv avails - -- Delete things that are hidden + -- Delete (qualified names of) things that are hidden gbl_env2 = foldl del_avail gbl_env1 hides + -- Add unqualified names + gbl_env3 | unqual_imp = foldl add_unqual gbl_env2 (rdrEnvToList gbl_env2) + | otherwise = gbl_env2 + + add_unqual env (qual_name, elts) + = foldl add_one env elts + where + add_one env elt = addOneToGlobalRdrEnv env unqual_name elt + unqual_name = unqualifyRdrName qual_name + -- The qualified import should only have added one + -- binding for each qualified name! But if there's an error in + -- the module (multiple bindings for the same name) we may get + -- duplicates. So the simple thing is to do the fold. + + del_avail env avail + = foldl delOneFromGlobalRdrEnv env rdr_names + where + rdr_names = map (mkRdrQual this_mod . nameOccName) + (availNames avail) + + add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv add_avail env avail = foldl add_name env (availNames avail) - add_name env name - | qual_imp && unqual_imp = env3 - | unqual_imp = env2 - | qual_imp = env1 - | otherwise = env + add_name env name -- Add qualified name only + = addOneToGlobalRdrEnv env (mkRdrQual this_mod occ) elt where - env1 = addOneToGlobalRdrEnv env (mkRdrQual this_mod occ) elt - env2 = addOneToGlobalRdrEnv env (mkRdrUnqual occ) elt - env3 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ) elt occ = nameOccName name elt = GRE name (mk_provenance name) (lookupDeprec deprecs name) - del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names - where - rdr_names = map (mkRdrUnqual . nameOccName) (availNames avail) - mkIfaceGlobalRdrEnv :: [(ModuleName,Avails)] -> GlobalRdrEnv -- Used to construct a GlobalRdrEnv for an interface that we've -- read from a .hi file. We can't construct the original top-level @@ -690,8 +701,8 @@ mkIfaceGlobalRdrEnv :: [(ModuleName,Avails)] -> GlobalRdrEnv mkIfaceGlobalRdrEnv m_avails = foldl add emptyRdrEnv m_avails where - add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True False [] - (\n -> LocalDef) avails NoDeprecs) + add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True + (\n -> LocalDef) avails [] NoDeprecs) -- The NoDeprecs is a bit of a hack I suppose \end{code} diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index 2bfe8a5..7c65a96 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/ghc/compiler/rename/RnNames.lhs @@ -177,8 +177,8 @@ importsFromImportDecl this_mod_name (ImportDecl imp_mod_name from qual_only as_m Just another_name -> another_name mk_prov name = NonLocalDef (UserImport imp_mod iloc (name `elemNameSet` explicits)) - gbl_env = mkGlobalRdrEnv qual_mod unqual_imp True hides mk_prov filtered_avails deprecs - exports = mkExportAvails qual_mod unqual_imp gbl_env filtered_avails + gbl_env = mkGlobalRdrEnv qual_mod unqual_imp mk_prov filtered_avails hides deprecs + exports = mkExportAvails qual_mod unqual_imp gbl_env filtered_avails in returnRn (gbl_env, exports) \end{code} @@ -212,7 +212,7 @@ importsFromLocalDecls this_mod decls mk_prov n = LocalDef -- Provenance is local hides = [] -- Hide nothing - gbl_env = mkGlobalRdrEnv mod_name unqual_imp True hides mk_prov avails NoDeprecs + gbl_env = mkGlobalRdrEnv mod_name unqual_imp mk_prov avails hides NoDeprecs -- NoDeprecs: don't complain about locally defined names -- For a start, we may be exporting a deprecated thing -- Also we may use a deprecated thing in the defn of another @@ -274,10 +274,9 @@ filterImports :: ModuleName -- The module being imported -> [AvailInfo] -- What's available -> RnMG ([AvailInfo], -- What's actually imported [AvailInfo], -- What's to be hidden - -- (the unqualified version, that is) - -- (We need to return both the above sets, because - -- the qualified version is never hidden; so we can't - -- implement hiding by reducing what's imported.) + -- (It's convenient to return both the above sets, because + -- the substraction can be done more efficiently when + -- building the environment.) NameSet) -- What was imported explicitly -- Complains if import spec mentions things that the module doesn't export @@ -310,6 +309,7 @@ filterImports mod from (Just (want_hiding, import_items)) total_avails bale_out item = addErrRn (badImportItemErr mod from item) `thenRn_` returnRn [] + get_item :: RdrNameIE -> RnMG [(AvailInfo, [Name])] get_item item@(IEModuleContents _) = bale_out item get_item item@(IEThingAll _) @@ -325,7 +325,7 @@ filterImports mod from (Just (want_hiding, import_items)) total_avails get_item item@(IEThingAbs n) | want_hiding -- hiding( C ) -- Here the 'C' can be a data constructor *or* a type/class - = case catMaybes [check_item item, check_item (IEThingAbs data_n)] of + = case catMaybes [check_item item, check_item (IEVar data_n)] of [] -> bale_out item avails -> returnRn [(a, []) | a <- avails] -- The 'explicits' list is irrelevant when hiding -- 1.7.10.4