Commit 5dffb4ac authored by Simon Peyton Jones's avatar Simon Peyton Jones

Refactor the way shadowing in handled in GHCi

If you say
  ghci> import Foo( T )
  ghci> data T = MkT
  ghci> data T = XXX
then the second 'data T' should shadow the first.  But the qualified
Foo.T should still be available.  We really weren't handling this
correctly at all, resulting in Trac #8639 and #8628 among others

This patch:

* Add RdrName.extendGlobalRdrEnv, which does shadowing properly

* Change HscTypes.icExtendGblRdrEnv (was badly-named icPlusGblRdrEnv)
  to use the new function

* Change RnNames.extendGobalRdrEnvRn to use the new function

* Move gresFrom Avails into RdrName
* Better pprGlobalRdrEnv function in RdrName
parent e60a841b
...@@ -8,15 +8,12 @@ module Avail ( ...@@ -8,15 +8,12 @@ module Avail (
availsToNameSet, availsToNameSet,
availsToNameEnv, availsToNameEnv,
availName, availNames, availName, availNames,
stableAvailCmp, stableAvailCmp
gresFromAvails,
gresFromAvail
) where ) where
import Name import Name
import NameEnv import NameEnv
import NameSet import NameSet
import RdrName
import Binary import Binary
import Outputable import Outputable
...@@ -77,24 +74,6 @@ availNames :: AvailInfo -> [Name] ...@@ -77,24 +74,6 @@ availNames :: AvailInfo -> [Name]
availNames (Avail n) = [n] availNames (Avail n) = [n]
availNames (AvailTC _ ns) = ns availNames (AvailTC _ ns) = ns
-- | make a 'GlobalRdrEnv' where all the elements point to the same
-- Provenance (useful for "hiding" imports, or imports with
-- no details).
gresFromAvails :: Provenance -> [AvailInfo] -> [GlobalRdrElt]
gresFromAvails prov avails
= concatMap (gresFromAvail (const prov)) avails
gresFromAvail :: (Name -> Provenance) -> AvailInfo -> [GlobalRdrElt]
gresFromAvail prov_fn avail
= [ GRE {gre_name = n,
gre_par = parent n avail,
gre_prov = prov_fn n}
| n <- availNames avail ]
where
parent _ (Avail _) = NoParent
parent n (AvailTC m _) | n == m = NoParent
| otherwise = ParentIs m
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- Printing -- Printing
......
...@@ -45,11 +45,14 @@ module RdrName ( ...@@ -45,11 +45,14 @@ module RdrName (
-- * Global mapping of 'RdrName' to 'GlobalRdrElt's -- * Global mapping of 'RdrName' to 'GlobalRdrElt's
GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv, GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,
lookupGlobalRdrEnv, extendGlobalRdrEnv, lookupGlobalRdrEnv, extendGlobalRdrEnv,
pprGlobalRdrEnv, globalRdrEnvElts, pprGlobalRdrEnv, globalRdrEnvElts,
lookupGRE_RdrName, lookupGRE_Name, getGRE_NameQualifier_maybes, lookupGRE_RdrName, lookupGRE_Name, getGRE_NameQualifier_maybes,
transformGREs, findLocalDupsRdrEnv, pickGREs, transformGREs, findLocalDupsRdrEnv, pickGREs,
-- * GlobalRdrElts
gresFromAvails, gresFromAvail,
-- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec' -- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec'
GlobalRdrElt(..), isLocalGRE, unQualOK, qualSpecOK, unQualSpecOK, GlobalRdrElt(..), isLocalGRE, unQualOK, qualSpecOK, unQualSpecOK,
Provenance(..), pprNameProvenance, Provenance(..), pprNameProvenance,
...@@ -62,6 +65,7 @@ module RdrName ( ...@@ -62,6 +65,7 @@ module RdrName (
import Module import Module
import Name import Name
import Avail
import NameSet import NameSet
import Maybes import Maybes
import SrcLoc import SrcLoc
...@@ -410,7 +414,25 @@ data GlobalRdrElt ...@@ -410,7 +414,25 @@ data GlobalRdrElt
data Parent = NoParent | ParentIs Name data Parent = NoParent | ParentIs Name
deriving (Eq) deriving (Eq)
{- Note [Parents] instance Outputable Parent where
ppr NoParent = empty
ppr (ParentIs n) = ptext (sLit "parent:") <> ppr n
plusParent :: Parent -> Parent -> Parent
-- See Note [Combining parents]
plusParent (ParentIs n) p2 = hasParent n p2
plusParent p1 (ParentIs n) = hasParent n p1
plusParent _ _ = NoParent
hasParent :: Name -> Parent -> Parent
#ifdef DEBUG
hasParent n (ParentIs n')
| n /= n' = pprPanic "hasParent" (ppr n <+> ppr n') -- Parents should agree
#endif
hasParent n _ = ParentIs n
\end{code}
Note [Parents]
~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~
Parent Children Parent Children
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
...@@ -449,25 +471,28 @@ those. For T that will mean we have ...@@ -449,25 +471,28 @@ those. For T that will mean we have
one GRE with Parent C one GRE with Parent C
one GRE with NoParent one GRE with NoParent
That's why plusParent picks the "best" case. That's why plusParent picks the "best" case.
-}
instance Outputable Parent where
ppr NoParent = empty
ppr (ParentIs n) = ptext (sLit "parent:") <> ppr n
\begin{code}
-- | make a 'GlobalRdrEnv' where all the elements point to the same
-- Provenance (useful for "hiding" imports, or imports with
-- no details).
gresFromAvails :: Provenance -> [AvailInfo] -> [GlobalRdrElt]
gresFromAvails prov avails
= concatMap (gresFromAvail (const prov)) avails
gresFromAvail :: (Name -> Provenance) -> AvailInfo -> [GlobalRdrElt]
gresFromAvail prov_fn avail
= [ GRE {gre_name = n,
gre_par = mkParent n avail,
gre_prov = prov_fn n}
| n <- availNames avail ]
where
plusParent :: Parent -> Parent -> Parent mkParent :: Name -> AvailInfo -> Parent
-- See Note [Combining parents] mkParent _ (Avail _) = NoParent
plusParent (ParentIs n) p2 = hasParent n p2 mkParent n (AvailTC m _) | n == m = NoParent
plusParent p1 (ParentIs n) = hasParent n p1 | otherwise = ParentIs m
plusParent _ _ = NoParent
hasParent :: Name -> Parent -> Parent
#ifdef DEBUG
hasParent n (ParentIs n')
| n /= n' = pprPanic "hasParent" (ppr n <+> ppr n') -- Parents should agree
#endif
hasParent n _ = ParentIs n
emptyGlobalRdrEnv :: GlobalRdrEnv emptyGlobalRdrEnv :: GlobalRdrEnv
emptyGlobalRdrEnv = emptyOccEnv emptyGlobalRdrEnv = emptyOccEnv
...@@ -479,25 +504,28 @@ instance Outputable GlobalRdrElt where ...@@ -479,25 +504,28 @@ instance Outputable GlobalRdrElt where
ppr gre = hang (ppr (gre_name gre) <+> ppr (gre_par gre)) ppr gre = hang (ppr (gre_name gre) <+> ppr (gre_par gre))
2 (pprNameProvenance gre) 2 (pprNameProvenance gre)
pprGlobalRdrEnv :: GlobalRdrEnv -> SDoc pprGlobalRdrEnv :: Bool -> GlobalRdrEnv -> SDoc
pprGlobalRdrEnv env pprGlobalRdrEnv locals_only env
= vcat (map pp (occEnvElts env)) = vcat [ ptext (sLit "GlobalRdrEnv") <+> ppWhen locals_only (ptext (sLit "(locals only)"))
<+> lbrace
, nest 2 (vcat [ pp (remove_locals gre_list) | gre_list <- occEnvElts env ]
<+> rbrace) ]
where where
pp gres = ppr (nameOccName (gre_name (head gres))) <> colon <+> remove_locals gres | locals_only = filter isLocalGRE gres
vcat (map ppr gres) | otherwise = gres
\end{code} pp [] = empty
pp gres = hang (ppr occ
<+> parens (ptext (sLit "unique") <+> ppr (getUnique occ))
<> colon)
2 (vcat (map ppr gres))
where
occ = nameOccName (gre_name (head gres))
\begin{code}
lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt] lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv env occ_name = case lookupOccEnv env occ_name of lookupGlobalRdrEnv env occ_name = case lookupOccEnv env occ_name of
Nothing -> [] Nothing -> []
Just gres -> gres Just gres -> gres
extendGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv
extendGlobalRdrEnv env gre = extendOccEnv_Acc (:) singleton env occ gre
where
occ = nameOccName (gre_name gre)
lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt] lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName rdr_name env lookupGRE_RdrName rdr_name env
= case lookupOccEnv env (rdrNameOcc rdr_name) of = case lookupOccEnv env (rdrNameOcc rdr_name) of
...@@ -519,6 +547,15 @@ getGRE_NameQualifier_maybes env ...@@ -519,6 +547,15 @@ getGRE_NameQualifier_maybes env
qualifier_maybe LocalDef = Nothing qualifier_maybe LocalDef = Nothing
qualifier_maybe (Imported iss) = Just $ map (is_as . is_decl) iss qualifier_maybe (Imported iss) = Just $ map (is_as . is_decl) iss
isLocalGRE :: GlobalRdrElt -> Bool
isLocalGRE (GRE {gre_prov = LocalDef}) = True
isLocalGRE _ = False
unQualOK :: GlobalRdrElt -> Bool
-- ^ Test if an unqualifed version of this thing would be in scope
unQualOK (GRE {gre_prov = LocalDef}) = True
unQualOK (GRE {gre_prov = Imported is}) = any unQualSpecOK is
pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt] pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
-- ^ Take a list of GREs which have the right OccName -- ^ Take a list of GREs which have the right OccName
-- Pick those GREs that are suitable for this RdrName -- Pick those GREs that are suitable for this RdrName
...@@ -580,16 +617,11 @@ pickGREs rdr_name gres ...@@ -580,16 +617,11 @@ pickGREs rdr_name gres
= filter ((== mod) . is_as . is_decl) is = filter ((== mod) . is_as . is_decl) is
| otherwise | otherwise
= [] = []
\end{code}
isLocalGRE :: GlobalRdrElt -> Bool Building GlobalRdrEnvs
isLocalGRE (GRE {gre_prov = LocalDef}) = True
isLocalGRE _ = False
unQualOK :: GlobalRdrElt -> Bool
-- ^ Test if an unqualifed version of this thing would be in scope
unQualOK (GRE {gre_prov = LocalDef}) = True
unQualOK (GRE {gre_prov = Imported is}) = any unQualSpecOK is
\begin{code}
plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2 plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2
...@@ -601,33 +633,6 @@ mkGlobalRdrEnv gres ...@@ -601,33 +633,6 @@ mkGlobalRdrEnv gres
(nameOccName (gre_name gre)) (nameOccName (gre_name gre))
gre gre
findLocalDupsRdrEnv :: GlobalRdrEnv -> [Name] -> [[GlobalRdrElt]]
-- ^ For each 'OccName', see if there are multiple local definitions
-- for it; return a list of all such
-- and return a list of the duplicate bindings
findLocalDupsRdrEnv rdr_env occs
= go rdr_env [] occs
where
go _ dups [] = dups
go rdr_env dups (name:names)
= case filter (pick name) gres of
[] -> go rdr_env dups names
[_] -> go rdr_env dups names -- The common case
dup_gres -> go rdr_env' (dup_gres : dups) names
where
occ = nameOccName name
gres = lookupOccEnv rdr_env occ `orElse` []
rdr_env' = delFromOccEnv rdr_env occ
-- The delFromOccEnv avoids repeating the same
-- complaint twice, when names itself has a duplicate
-- which is a common case
-- See Note [Template Haskell binders in the GlobalRdrEnv]
pick name (GRE { gre_name = n, gre_prov = LocalDef })
| isInternalName name = isInternalName n
| otherwise = True
pick _ _ = False
insertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt] insertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
insertGRE new_g [] = [new_g] insertGRE new_g [] = [new_g]
insertGRE new_g (old_g : old_gs) insertGRE new_g (old_g : old_gs)
...@@ -654,6 +659,77 @@ transformGREs trans_gre occs rdr_env ...@@ -654,6 +659,77 @@ transformGREs trans_gre occs rdr_env
= case lookupOccEnv env occ of = case lookupOccEnv env occ of
Just gres -> extendOccEnv env occ (map trans_gre gres) Just gres -> extendOccEnv env occ (map trans_gre gres)
Nothing -> env Nothing -> env
extendGlobalRdrEnv :: Bool -> GlobalRdrEnv -> [AvailInfo] -> GlobalRdrEnv
-- Extend with new LocalDef GREs from the AvailInfos.
--
-- If do_shadowing is True, first remove name clashes between the new
-- AvailInfos and the existing GlobalRdrEnv.
-- This is used by the GHCi top-level
--
-- E.g. Adding a LocalDef "x" when there is an existing GRE for Q.x
-- should remove any unqualified import of Q.x,
-- leaving only the qualified one
--
-- However do *not* remove name clashes between the AvailInfos themselves,
-- so that (say) data T = A | A
-- will still give a duplicate-binding error.
-- Same thing if there are multiple AvailInfos (don't remove clashes),
-- though I'm not sure this ever happens with do_shadowing=True
extendGlobalRdrEnv do_shadowing env avails
= foldl add_avail env1 avails
where
names = concatMap availNames avails
env1 | do_shadowing = foldl shadow_name env names
| otherwise = env
-- By doing the removal first, we ensure that the new AvailInfos
-- don't shadow each other; that would conceal genuine errors
-- E.g. in GHCi data T = A | A
add_avail env avail = foldl (add_name avail) env (availNames avail)
add_name avail env name
= extendOccEnv_Acc (:) singleton env occ gre
where
occ = nameOccName name
gre = GRE { gre_name = name
, gre_par = mkParent name avail
, gre_prov = LocalDef }
shadow_name :: GlobalRdrEnv -> Name -> GlobalRdrEnv
shadow_name env name
= alterOccEnv (fmap alter_fn) env (nameOccName name)
where
alter_fn :: [GlobalRdrElt] -> [GlobalRdrElt]
alter_fn gres = mapCatMaybes (shadow_with name) gres
shadow_with :: Name -> GlobalRdrElt -> Maybe GlobalRdrElt
shadow_with new_name old_gre@(GRE { gre_name = old_name, gre_prov = LocalDef })
= case (nameModule_maybe old_name, nameModule_maybe new_name) of
(Nothing, _) -> Nothing
(Just old_mod, Just new_mod) | new_mod == old_mod -> Nothing
(Just old_mod, _) -> Just (old_gre { gre_prov = Imported [fake_imp_spec] })
where
fake_imp_spec = ImpSpec id_spec ImpAll -- Urgh!
old_mod_name = moduleName old_mod
id_spec = ImpDeclSpec { is_mod = old_mod_name
, is_as = old_mod_name
, is_qual = True
, is_dloc = nameSrcSpan old_name }
shadow_with new_name old_gre@(GRE { gre_prov = Imported imp_specs })
| null imp_specs' = Nothing
| otherwise = Just (old_gre { gre_prov = Imported imp_specs' })
where
imp_specs' = mapCatMaybes (shadow_is new_name) imp_specs
shadow_is :: Name -> ImportSpec -> Maybe ImportSpec
shadow_is new_name is@(ImpSpec { is_decl = id_spec })
| Just new_mod <- nameModule_maybe new_name
, is_as id_spec == moduleName new_mod
= Nothing -- Shadow both qualified and unqualified
| otherwise -- Shadow unqualified only
= Just (is { is_decl = id_spec { is_qual = True } })
\end{code} \end{code}
Note [Template Haskell binders in the GlobalRdrEnv] Note [Template Haskell binders in the GlobalRdrEnv]
...@@ -663,6 +739,35 @@ in RnNames, a GRE with an Internal gre_name (i.e. one generated by a TH decl ...@@ -663,6 +739,35 @@ in RnNames, a GRE with an Internal gre_name (i.e. one generated by a TH decl
quote) should *shadow* a GRE with an External gre_name. Hence some faffing quote) should *shadow* a GRE with an External gre_name. Hence some faffing
around in pickGREs and findLocalDupsRdrEnv around in pickGREs and findLocalDupsRdrEnv
\begin{code}
findLocalDupsRdrEnv :: GlobalRdrEnv -> [Name] -> [[GlobalRdrElt]]
-- ^ For each 'OccName', see if there are multiple local definitions
-- for it; return a list of all such
-- and return a list of the duplicate bindings
findLocalDupsRdrEnv rdr_env occs
= go rdr_env [] occs
where
go _ dups [] = dups
go rdr_env dups (name:names)
= case filter (pick name) gres of
[] -> go rdr_env dups names
[_] -> go rdr_env dups names -- The common case
dup_gres -> go rdr_env' (dup_gres : dups) names
where
occ = nameOccName name
gres = lookupOccEnv rdr_env occ `orElse` []
rdr_env' = delFromOccEnv rdr_env occ
-- The delFromOccEnv avoids repeating the same
-- complaint twice, when names itself has a duplicate
-- which is a common case
-- See Note [Template Haskell binders in the GlobalRdrEnv]
pick name (GRE { gre_name = n, gre_prov = LocalDef })
| isInternalName name = isInternalName n
| otherwise = True
pick _ _ = False
\end{code}
%************************************************************************ %************************************************************************
%* * %* *
Provenance Provenance
......
...@@ -45,7 +45,6 @@ import TcIface ...@@ -45,7 +45,6 @@ import TcIface
import LoadIface import LoadIface
import Finder import Finder
import PrelNames import PrelNames
import Avail
import RdrName import RdrName
import HscTypes import HscTypes
import Bag import Bag
......
...@@ -1439,11 +1439,12 @@ hscDeclsWithLocation hsc_env0 str source linenumber = ...@@ -1439,11 +1439,12 @@ hscDeclsWithLocation hsc_env0 str source linenumber =
ext_ids = [ id | id <- bindersOfBinds core_binds ext_ids = [ id | id <- bindersOfBinds core_binds
, isExternalName (idName id) , isExternalName (idName id)
, not (isDFunId id) ] , not (isDFunId id || isImplicitId id) ]
-- We only need to keep around the external bindings -- We only need to keep around the external bindings
-- (as decided by TidyPgm), since those are the only ones -- (as decided by TidyPgm), since those are the only ones
-- that might be referenced elsewhere. -- that might be referenced elsewhere.
-- The DFunIds are in 'insts' (see Note [ic_tythings] in HscTypes -- The DFunIds are in 'insts' (see Note [ic_tythings] in HscTypes
-- Implicit Ids are implicit in tcs
tythings = map AnId ext_ids ++ map ATyCon tcs tythings = map AnId ext_ids ++ map ATyCon tcs
......
...@@ -48,7 +48,7 @@ module HscTypes ( ...@@ -48,7 +48,7 @@ module HscTypes (
-- * Interactive context -- * Interactive context
InteractiveContext(..), emptyInteractiveContext, InteractiveContext(..), emptyInteractiveContext,
icPrintUnqual, icInScopeTTs, icPlusGblRdrEnv, icPrintUnqual, icInScopeTTs, icExtendGblRdrEnv,
extendInteractiveContext, substInteractiveContext, extendInteractiveContext, substInteractiveContext,
setInteractivePrintName, setInteractivePrintName,
InteractiveImport(..), InteractiveImport(..),
...@@ -1197,7 +1197,7 @@ icPrintUnqual dflags InteractiveContext{ ic_rn_gbl_env = grenv } = ...@@ -1197,7 +1197,7 @@ icPrintUnqual dflags InteractiveContext{ ic_rn_gbl_env = grenv } =
extendInteractiveContext :: InteractiveContext -> [TyThing] -> InteractiveContext extendInteractiveContext :: InteractiveContext -> [TyThing] -> InteractiveContext
extendInteractiveContext ictxt new_tythings extendInteractiveContext ictxt new_tythings
= ictxt { ic_tythings = new_tythings ++ old_tythings = ictxt { ic_tythings = new_tythings ++ old_tythings
, ic_rn_gbl_env = new_tythings `icPlusGblRdrEnv` ic_rn_gbl_env ictxt , ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings
} }
where where
old_tythings = filter (not . shadowed) (ic_tythings ictxt) old_tythings = filter (not . shadowed) (ic_tythings ictxt)
...@@ -1214,19 +1214,22 @@ setInteractivePrintName ic n = ic{ic_int_print = n} ...@@ -1214,19 +1214,22 @@ setInteractivePrintName ic n = ic{ic_int_print = n}
-- | Add TyThings to the GlobalRdrEnv, earlier ones in the list shadowing -- | Add TyThings to the GlobalRdrEnv, earlier ones in the list shadowing
-- later ones, and shadowing existing entries in the GlobalRdrEnv. -- later ones, and shadowing existing entries in the GlobalRdrEnv.
icPlusGblRdrEnv :: [TyThing] -> GlobalRdrEnv -> GlobalRdrEnv icExtendGblRdrEnv :: GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv
icPlusGblRdrEnv tythings env = extendOccEnvList env list icExtendGblRdrEnv env tythings
where new_gres = gresFromAvails LocalDef (map tyThingAvailInfo tythings) = foldr add env tythings -- Foldr makes things in the front of
list = [ (nameOccName (gre_name gre), [gre]) | gre <- new_gres ] -- the list shadow things at the back
where
add thing env = extendGlobalRdrEnv True {- Shadowing please -} env
[tyThingAvailInfo thing]
-- One at a time, to ensure each shadows the previous ones
substInteractiveContext :: InteractiveContext -> TvSubst -> InteractiveContext substInteractiveContext :: InteractiveContext -> TvSubst -> InteractiveContext
substInteractiveContext ictxt subst
| isEmptyTvSubst subst = ictxt
substInteractiveContext ictxt@InteractiveContext{ ic_tythings = tts } subst substInteractiveContext ictxt@InteractiveContext{ ic_tythings = tts } subst
= ictxt { ic_tythings = map subst_ty tts } | isEmptyTvSubst subst = ictxt
where subst_ty (AnId id) = AnId $ id `setIdType` substTy subst (idType id) | otherwise = ictxt { ic_tythings = map subst_ty tts }
subst_ty tt = tt where
subst_ty (AnId id) = AnId $ id `setIdType` substTy subst (idType id)
subst_ty tt = tt
data InteractiveImport data InteractiveImport
= IIDecl (ImportDecl RdrName) = IIDecl (ImportDecl RdrName)
...@@ -1241,7 +1244,6 @@ data InteractiveImport ...@@ -1241,7 +1244,6 @@ data InteractiveImport
instance Outputable InteractiveImport where instance Outputable InteractiveImport where
ppr (IIModule m) = char '*' <> ppr m ppr (IIModule m) = char '*' <> ppr m
ppr (IIDecl d) = ppr d ppr (IIDecl d) = ppr d
\end{code} \end{code}
%************************************************************************ %************************************************************************
......
...@@ -813,7 +813,7 @@ setContext imports ...@@ -813,7 +813,7 @@ setContext imports
liftIO $ throwGhcExceptionIO (formatError dflags mod err) liftIO $ throwGhcExceptionIO (formatError dflags mod err)
Right all_env -> do { Right all_env -> do {
; let old_ic = hsc_IC hsc_env ; let old_ic = hsc_IC hsc_env
final_rdr_env = ic_tythings old_ic `icPlusGblRdrEnv` all_env final_rdr_env = all_env `icExtendGblRdrEnv` ic_tythings old_ic
; modifySession $ \_ -> ; modifySession $ \_ ->
hsc_env{ hsc_IC = old_ic { ic_imports = imports hsc_env{ hsc_IC = old_ic { ic_imports = imports
, ic_rn_gbl_env = final_rdr_env }}}} , ic_rn_gbl_env = final_rdr_env }}}}
......
...@@ -411,44 +411,41 @@ extendGlobalRdrEnvRn avails new_fixities ...@@ -411,44 +411,41 @@ extendGlobalRdrEnvRn avails new_fixities
inBracket = isBrackStage stage inBracket = isBrackStage stage
lcl_env_TH = lcl_env { tcl_rdr = delLocalRdrEnvList (tcl_rdr lcl_env) new_occs } lcl_env_TH = lcl_env { tcl_rdr = delLocalRdrEnvList (tcl_rdr lcl_env) new_occs }
rdr_env_GHCi = delListFromOccEnv rdr_env new_occs lcl_env2 | inBracket = lcl_env_TH
-- This seems a bit brutal. | otherwise = lcl_env
-- Mightn't we lose some qualified bindings that we want?
-- e.g. ghci> import Prelude as Q rdr_env2 = extendGlobalRdrEnv (isGHCi && not inBracket) rdr_env avails
-- ghci> data Int = Mk Q.Int -- Shadowing only applies for GHCi decls outside brackets
-- This fails because we expunge the binding for Prelude.Q -- e.g. (Trac #4127a)
-- ghci> runQ [d| class C a where f :: a
(rdr_env2, lcl_env2) | inBracket = (rdr_env, lcl_env_TH) -- f = True
| isGHCi = (rdr_env_GHCi, lcl_env) -- instance C Int where f = 2 |]
| otherwise = (rdr_env, lcl_env) -- We don't want the f=True to shadow the f class-op
rdr_env3 = foldl extendGlobalRdrEnv rdr_env2 new_gres
lcl_env3 = lcl_env2 { tcl_th_bndrs = extendNameEnvList th_bndrs lcl_env3 = lcl_env2 { tcl_th_bndrs = extendNameEnvList th_bndrs
[ (n, (TopLevel, th_lvl)) [ (n, (TopLevel, th_lvl))
| n <- new_names ] } | n <- new_names ] }
fix_env' = foldl extend_fix_env fix_env new_gres fix_env' = foldl extend_fix_env fix_env new_names
dups = findLocalDupsRdrEnv rdr_env3 new_names dups = findLocalDupsRdrEnv rdr_env2 new_names
gbl_env' = gbl_env { tcg_rdr_env = rdr_env3, tcg_fix_env = fix_env' } gbl_env' = gbl_env { tcg_rdr_env = rdr_env2, tcg_fix_env = fix_env' }
; traceRn (text "extendGlobalRdrEnvRn dups" <+> (ppr dups)) ; traceRn (text "extendGlobalRdrEnvRn 1" <+> (ppr avails $$ (ppr dups)))
; mapM_ (addDupDeclErr . map gre_name) dups ; mapM_ (addDupDeclErr . map gre_name) dups
; traceRn (text "extendGlobalRdrEnvRn" <+> (ppr new_fixities $$ ppr fix_env $$ ppr fix_env')) ; traceRn (text "extendGlobalRdrEnvRn 2" <+> (pprGlobalRdrEnv True rdr_env2))
; return (gbl_env', lcl_env3) } ; return (gbl_env', lcl_env3) }
where where
new_gres = gresFromAvails LocalDef avails new_names = concatMap availNames avails
new_names = map gre_name new_gres
new_occs = map nameOccName new_names new_occs = map nameOccName new_names
-- If there is a fixity decl for the gre, add it to the fixity env -- If there is a fixity decl for the gre, add it to the fixity env
extend_fix_env fix_env gre extend_fix_env fix_env name
| Just (L _ fi) <- lookupFsEnv new_fixities (occNameFS occ) | Just (L _ fi) <- lookupFsEnv new_fixities (occNameFS occ)
= extendNameEnv fix_env name (FixItem occ fi) = extendNameEnv fix_env name (FixItem occ fi)
| otherwise | otherwise
= fix_env = fix_env
where where
name = gre_name gre
occ = nameOccName name occ = nameOccName name
\end{code} \end{code}
...@@ -476,6 +473,7 @@ getLocalNonValBinders fixity_env ...@@ -476,6 +473,7 @@ getLocalNonValBinders fixity_env
hs_fords = foreign_decls }) hs_fords = foreign_decls })
= do { -- Process all type/class decls *except* family instances = do { -- Process all type/class decls *except* family instances
; tc_avails <- mapM new_tc (tyClGroupConcat tycl_decls) ; tc_avails <- mapM new_tc (tyClGroupConcat tycl_decls)
; traceRn (text "getLocalNonValBinders 1" <+> ppr tc_avails)
; envs <- extendGlobalRdrEnvRn tc_avails fixity_env ; envs <- extendGlobalRdrEnvRn tc_avails fixity_env
; setEnvs envs $ do { ; setEnvs envs $ do {
-- Bring these things into scope first -- Bring these things into scope first
...@@ -496,6 +494,7 @@ getLocalNonValBinders fixity_env ...@@ -496,6 +494,7 @@ getLocalNonValBinders fixity_env
; let avails = nti_avails ++ val_avails ; let avails = nti_avails ++ val_avails
new_bndrs = availsToNameSet avails `unionNameSets` new_bndrs = availsToNameSet avails `unionNameSets`
availsToNameSet tc_avails availsToNameSet tc_avails
; traceRn (text "getLocalNonValBinders 2" <+> ppr avails)
; envs <- extendGlobalRdrEnvRn avails fixity_env ; envs <- extendGlobalRdrEnvRn avails fixity_env
; return (envs, new_bndrs) } } ; return (envs, new_bndrs) } }
where where
......
...@@ -114,6 +114,7 @@ rnSrcDecls extra_deps group@(HsGroup { hs_valds = val_decls, ...@@ -114,6 +114,7 @@ rnSrcDecls extra_deps group@(HsGroup { hs_valds = val_decls,
let { val_binders = collectHsValBinders new_lhs ; let { val_binders = collectHsValBinders new_lhs ;