From 2c183f9b2a148d4c6821d5b9a4ec3d18ee957263 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Thu, 1 Jul 2010 14:01:24 +0000 Subject: [PATCH] Fix second bug in Trac #4127 This bug concerned the awkward shadowing we do for Template Haskell declaration brackets. Lots of comments in Note [Top-level Names in Template Haskell decl quotes] --- compiler/basicTypes/RdrName.lhs | 42 +++++++----------------- compiler/rename/RnNames.lhs | 68 +++++++++++++++++++++++++++++++-------- 2 files changed, 65 insertions(+), 45 deletions(-) diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs index 6db15bc..c5b777b 100644 --- a/compiler/basicTypes/RdrName.lhs +++ b/compiler/basicTypes/RdrName.lhs @@ -48,7 +48,7 @@ module RdrName ( lookupGlobalRdrEnv, extendGlobalRdrEnv, pprGlobalRdrEnv, globalRdrEnvElts, lookupGRE_RdrName, lookupGRE_Name, getGRE_NameQualifier_maybes, - hideSomeUnquals, findLocalDupsRdrEnv, pickGREs, + transformGREs, findLocalDupsRdrEnv, pickGREs, -- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec' GlobalRdrElt(..), isLocalGRE, unQualOK, qualSpecOK, unQualSpecOK, @@ -549,37 +549,17 @@ plusGRE g1 g2 gre_prov = gre_prov g1 `plusProv` gre_prov g2, gre_par = gre_par g1 `plusParent` gre_par 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 module must certainly still be available - --- Seems like 5 times as much work as it deserves! -hideSomeUnquals rdr_env occs - = foldr hide rdr_env occs +transformGREs :: (GlobalRdrElt -> GlobalRdrElt) + -> [OccName] + -> GlobalRdrEnv -> GlobalRdrEnv +-- ^ Apply a transformation function to the GREs for these OccNames +transformGREs trans_gre occs rdr_env + = foldr trans 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_prov = Imported [imp_spec] } - where -- Local defs get transfomed to (fake) imported things - mod = ASSERT2( isExternalName name, ppr name) 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 } } + trans occ env + = case lookupOccEnv env occ of + Just gres -> extendOccEnv env occ (map trans_gre gres) + Nothing -> env \end{code} %************************************************************************ diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 77597d4..2f62681 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -273,23 +273,34 @@ top level binders specially in two ways 2. We make them *shadow* the outer bindings. If we don't do that, we'll get a complaint when extending the GlobalRdrEnv, saying that - there are two bindings for 'f'. - - This shadowing applies even if the binding for 'f' is in a - where-clause, and hence is in the *local* RdrEnv not the *global* - RdrEnv. - -We find out whether we are inside a [d| ... |] by testing the TH -stage. This is a slight hack, because the stage field was really meant for -the type checker, and here we are not interested in the fields of Brack, -hence the error thunks in thRnBrack. + there are two bindings for 'f'. There are several tricky points: + + * This shadowing applies even if the binding for 'f' is in a + where-clause, and hence is in the *local* RdrEnv not the *global* + RdrEnv. + + * The *qualified* name M.f from the enclosing module must certainly + still be available. So we don't nuke it entirely; we just make + it seem like qualified import. + + * We only shadow *External* names (which come from the main module) + Do not shadow *Inernal* names because in the bracket + [d| class C a where f :: a + f = 4 |] + rnSrcDecls will first call extendGlobalRdrEnvRn with C[f] from the + class decl, and *separately* extend the envt with the value binding. + +3. We find out whether we are inside a [d| ... |] by testing the TH + stage. This is a slight hack, because the stage field was really + meant for the type checker, and here we are not interested in the + fields of Brack, hence the error thunks in thRnBrack. \begin{code} extendGlobalRdrEnvRn :: [AvailInfo] -> MiniFixityEnv -> RnM (TcGblEnv, TcLclEnv) -- Updates both the GlobalRdrEnv and the FixityEnv - -- We return a new TcLclEnv only becuase we might have to + -- We return a new TcLclEnv only because we might have to -- delete some bindings from it; -- see Note [Top-level Names in Template Haskell decl quotes] @@ -305,7 +316,7 @@ extendGlobalRdrEnvRn avails new_fixities -- See Note [Top-level Names in Template Haskell decl quotes] shadowP = isBrackStage stage new_occs = map (nameOccName . gre_name) gres - rdr_env1 = hideSomeUnquals rdr_env new_occs + rdr_env1 = transformGREs qual_gre new_occs rdr_env lcl_env1 = lcl_env { tcl_rdr = delListFromOccEnv (tcl_rdr lcl_env) new_occs } (rdr_env2, lcl_env2) | shadowP = (rdr_env1, lcl_env1) | otherwise = (rdr_env, lcl_env) @@ -332,6 +343,35 @@ extendGlobalRdrEnvRn avails new_fixities where name = gre_name gre occ = nameOccName name + + qual_gre :: GlobalRdrElt -> GlobalRdrElt + -- Transform top-level GREs from the module being compiled + -- so that they are out of the way of new definitions in a Template + -- Haskell bracket + -- See Note [Top-level Names in Template Haskell decl quotes] + -- Seems like 5 times as much work as it deserves! + -- + -- For a LocalDef we make a (fake) qualified imported GRE for a + -- local GRE so that the original *qualified* name is still in scope + -- but the *unqualified* one no longer is. What a hack! + + qual_gre gre@(GRE { gre_prov = LocalDef, gre_name = name }) + | isExternalName name = gre { gre_prov = Imported [imp_spec] } + | otherwise = gre + -- Do not shadow Internal (ie Template Haskell) Names + -- See Note [Top-level Names in Template Haskell decl quotes] + where + mod = ASSERT2( isExternalName name, ppr name) 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, -- Qualified only! + 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} @getLocalDeclBinders@ returns the names for an @HsDecl@. It's @@ -389,8 +429,8 @@ getLocalNonValBinders :: HsGroup RdrName -> RnM [AvailInfo] -- Get all the top-level binders bound the group *except* -- for value bindings, which are treated separately -- Specificaly we return AvailInfo for --- type decls --- class decls +-- type decls (incl constructors and record selectors) +-- class decls (including class ops) -- associated types -- foreign imports -- (in hs-boot files) value signatures -- 1.7.10.4