From 8c3e6304e6a5fe3dbbdf2223de0ccc0f96d2a913 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Thu, 7 Sep 2006 14:18:45 +0000 Subject: [PATCH] Fix the handling of names in declaration brackets The handling of top-level names in declaration brackets is a bit tricky. This commit fixes Trac #977; test is TH_spliceD2. The changes are commented in RnExpr.rnBracket and RdrName.hideSomeUnquals --- compiler/basicTypes/RdrName.lhs | 39 +++++++++++++++++++++++++++++++++++---- compiler/rename/RnExpr.lhs | 35 ++++++++++++++++++----------------- 2 files changed, 53 insertions(+), 21 deletions(-) diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs index e99a41e..8729f47 100644 --- a/compiler/basicTypes/RdrName.lhs +++ b/compiler/basicTypes/RdrName.lhs @@ -29,7 +29,7 @@ module RdrName ( GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv, lookupGlobalRdrEnv, extendGlobalRdrEnv, pprGlobalRdrEnv, globalRdrEnvElts, - lookupGRE_RdrName, lookupGRE_Name, + lookupGRE_RdrName, lookupGRE_Name, hideSomeUnquals, -- GlobalRdrElt, Provenance, ImportSpec GlobalRdrElt(..), isLocalGRE, unQualOK, @@ -45,7 +45,7 @@ import Module ( ModuleName, mkModuleNameFS, Module, moduleName ) import Name ( Name, NamedThing(getName), nameModule, nameParent_maybe, nameOccName, isExternalName, nameSrcLoc ) import Maybes ( mapCatMaybes ) -import SrcLoc ( isGoodSrcLoc, isGoodSrcSpan, SrcSpan ) +import SrcLoc ( isGoodSrcLoc, isGoodSrcSpan, srcLocSpan, SrcSpan ) import FastString ( FastString ) import Outputable import Util ( thenCmp ) @@ -428,6 +428,35 @@ plusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt plusGRE g1 g2 = GRE { gre_name = gre_name g1, gre_prov = gre_prov g1 `plusProv` gre_prov g2 } + +hideSomeUnquals :: GlobalRdrEnv -> [OccName] -> GlobalRdrEnv +-- Hide any unqualified bindings for the specified OccNames +-- This is used in TH, when renaming a declaration bracket +-- [d| foo = ... |] +-- We want unqualified 'foo' in "..." to mean this foo, not +-- the one from the enclosing module. But the *qualified* name +-- from the enclosing moudule must certainly still be avaialable +-- Seems like 5 times as much work as it deserves! +hideSomeUnquals rdr_env occs + = foldr hide rdr_env occs + where + hide occ env + | Just gres <- lookupOccEnv env occ = extendOccEnv env occ (map qual_gre gres) + | otherwise = env + qual_gre gre@(GRE { gre_name = name, gre_prov = LocalDef }) + = GRE { gre_name = name, gre_prov = Imported [imp_spec] } + where -- Local defs get transfomed to (fake) imported things + mod = moduleName (nameModule name) + imp_spec = ImpSpec { is_item = ImpAll, is_decl = decl_spec } + decl_spec = ImpDeclSpec { is_mod = mod, is_as = mod, + is_qual = True, + is_dloc = srcLocSpan (nameSrcLoc name) } + + qual_gre gre@(GRE { gre_prov = Imported specs }) + = gre { gre_prov = Imported (map qual_spec specs) } + + qual_spec spec@(ImpSpec { is_decl = decl_spec }) + = spec { is_decl = decl_spec { is_qual = True } } \end{code} @@ -529,8 +558,10 @@ pprNameProvenance :: GlobalRdrElt -> SDoc -- Print out the place where the name was imported pprNameProvenance (GRE {gre_name = name, gre_prov = LocalDef}) = ptext SLIT("defined at") <+> ppr (nameSrcLoc name) -pprNameProvenance (GRE {gre_name = name, gre_prov = Imported (why:whys)}) - = sep [ppr why, nest 2 (ppr_defn (nameSrcLoc name))] +pprNameProvenance (GRE {gre_name = name, gre_prov = Imported whys}) + = case whys of + (why:whys) -> sep [ppr why, nest 2 (ppr_defn (nameSrcLoc name))] + [] -> panic "pprNameProvenance" -- If we know the exact definition point (which we may do with GHCi) -- then show that too. But not if it's just "imported from X". diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs index 99d0767..735bdc3 100644 --- a/compiler/rename/RnExpr.lhs +++ b/compiler/rename/RnExpr.lhs @@ -43,7 +43,7 @@ import Name ( isTyVarName ) #endif import Name ( Name, nameOccName, nameIsLocalOrFrom ) import NameSet -import RdrName ( RdrName, emptyGlobalRdrEnv, extendLocalRdrEnv, lookupLocalRdrEnv ) +import RdrName ( RdrName, emptyGlobalRdrEnv, extendLocalRdrEnv, lookupLocalRdrEnv, hideSomeUnquals ) import LoadIface ( loadInterfaceForName ) import UniqFM ( isNullUFM ) import UniqSet ( emptyUniqSet ) @@ -573,25 +573,26 @@ rnBracket (DecBr group) -- confuse the Names for the current module. -- By using a pretend module, thFAKE, we keep them safely out of the way. - ; names <- getLocalDeclBinders gbl_env1 group - ; rdr_env' <- extendRdrEnvRn emptyGlobalRdrEnv names - -- Furthermore, the names in the bracket shouldn't conflict with - -- existing top-level names E.g. + ; names <- getLocalDeclBinders gbl_env1 group + + ; let new_occs = map nameOccName names + trimmed_rdr_env = hideSomeUnquals (tcg_rdr_env gbl_env) new_occs + + ; rdr_env' <- extendRdrEnvRn trimmed_rdr_env names + -- In this situation we want to *shadow* top-level bindings. -- foo = 1 -- bar = [d| foo = 1|] - -- But both 'foo's get a LocalDef provenance, so we'd get a complaint unless - -- we start with an emptyGlobalRdrEnv - - ; setGblEnv (gbl_env { tcg_rdr_env = tcg_rdr_env gbl_env1 `plusOccEnv` rdr_env', + -- If we don't shadow, we'll get an ambiguity complaint when we do + -- a lookupTopBndrRn (which uses lookupGreLocalRn) on the binder of the 'foo' + -- + -- Furthermore, arguably if the splice does define foo, that should hide + -- any foo's further out + -- + -- The shadowing is acheived by the call to hideSomeUnquals, which removes + -- the unqualified bindings of things defined by the bracket + + ; setGblEnv (gbl_env { tcg_rdr_env = rdr_env', tcg_dus = emptyDUs }) $ do - -- Notice plusOccEnv, not plusGlobalRdrEnv. In this situation we want - -- to *shadow* top-level bindings. (See the 'foo' example above.) - -- If we don't shadow, we'll get an ambiguity complaint when we do - -- a lookupTopBndrRn (which uses lookupGreLocalRn) on the binder of the 'foo' - -- - -- Furthermore, arguably if the splice does define foo, that should hide - -- any foo's further out - -- -- The emptyDUs is so that we just collect uses for this group alone { (tcg_env, group') <- rnSrcDecls group -- 1.7.10.4