Commit 8c3e6304 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

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
parent 74c36221
......@@ -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".
......
......@@ -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
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment