Commit a3f6239d authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

GHCi: fix scoping for record selectors

This fixes Trac #10520.  See the "Ugh" note about
record selectors in HscTypes.icExtendGblRdrEnv.
parent efa136f7
......@@ -1513,16 +1513,15 @@ hscDeclsWithLocation hsc_env0 str source linenumber =
, not (isDFunId id || isImplicitId id) ]
-- We only need to keep around the external bindings
-- (as decided by TidyPgm), since those are the only ones
-- that might be referenced elsewhere.
-- The DFunIds are in 'cls_insts' (see Note [ic_tythings] in HscTypes
-- Implicit Ids are implicit in tcs
tythings = map AnId ext_ids ++ map ATyCon tcs ++ map (AConLike . PatSynCon) patsyns
let icontext = hsc_IC hsc_env
ictxt = extendInteractiveContext icontext ext_ids tcs
cls_insts fam_insts defaults patsyns
return (tythings, ictxt)
-- that might later be looked up by name. But we can exclude
-- - DFunIds, which are in 'cls_insts' (see Note [ic_tythings] in HscTypes
-- - Implicit Ids, which are implicit in tcs
-- c.f. TcRnDriver.runTcInteractive, which reconstructs the TypeEnv
new_tythings = map AnId ext_ids ++ map ATyCon tcs ++ map (AConLike . PatSynCon) patsyns
ictxt = hsc_IC hsc_env
new_ictxt = extendInteractiveContext ictxt new_tythings cls_insts fam_insts defaults
return (new_tythings, new_ictxt)
hscImport :: HscEnv -> String -> IO (ImportDecl RdrName)
hscImport hsc_env str = runInteractiveHsc hsc_env $ do
......
......@@ -1402,12 +1402,11 @@ icPrintUnqual dflags InteractiveContext{ ic_rn_gbl_env = grenv } =
-- to them (e.g. instances for classes or values of the type for TyCons), it's
-- not clear whether removing them is even the appropriate behavior.
extendInteractiveContext :: InteractiveContext
-> [Id] -> [TyCon]
-> [TyThing]
-> [ClsInst] -> [FamInst]
-> Maybe [Type]
-> [PatSyn]
-> InteractiveContext
extendInteractiveContext ictxt ids tcs new_cls_insts new_fam_insts defaults new_patsyns
extendInteractiveContext ictxt new_tythings new_cls_insts new_fam_insts defaults
= ictxt { ic_mod_index = ic_mod_index ictxt + 1
-- Always bump this; even instances should create
-- a new mod_index (Trac #9426)
......@@ -1417,8 +1416,8 @@ extendInteractiveContext ictxt ids tcs new_cls_insts new_fam_insts defaults new_
, new_fam_insts ++ old_fam_insts )
, ic_default = defaults }
where
new_tythings = map AnId ids ++ map ATyCon tcs ++ map (AConLike . PatSynCon) new_patsyns
old_tythings = filterOut (shadowed_by ids) (ic_tythings ictxt)
new_ids = [id | AnId id <- new_tythings]
old_tythings = filterOut (shadowed_by new_ids) (ic_tythings ictxt)
-- Discard old instances that have been fully overrridden
-- See Note [Override identical instances in GHCi]
......@@ -1427,14 +1426,15 @@ extendInteractiveContext ictxt ids tcs new_cls_insts new_fam_insts defaults new_
old_fam_insts = filterOut (\i -> any (identicalFamInstHead i) new_fam_insts) fam_insts
extendInteractiveContextWithIds :: InteractiveContext -> [Id] -> InteractiveContext
extendInteractiveContextWithIds ictxt ids
| null ids = ictxt
-- Just a specialised version
extendInteractiveContextWithIds ictxt new_ids
| null new_ids = ictxt
| otherwise = ictxt { ic_mod_index = ic_mod_index ictxt + 1
, ic_tythings = new_tythings ++ old_tythings
, ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings }
where
new_tythings = map AnId ids
old_tythings = filterOut (shadowed_by ids) (ic_tythings ictxt)
new_tythings = map AnId new_ids
old_tythings = filterOut (shadowed_by new_ids) (ic_tythings ictxt)
shadowed_by :: [Id] -> TyThing -> Bool
shadowed_by ids = shadowed
......@@ -1460,11 +1460,26 @@ icExtendGblRdrEnv env tythings
-- the list shadow things at the back
where
-- One at a time, to ensure each shadows the previous ones
add thing env = foldl extendGlobalRdrEnv env1 (localGREsFromAvail avail)
add thing env
| is_sub_bndr thing
= env
| otherwise
= foldl extendGlobalRdrEnv env1 (localGREsFromAvail avail)
where
env1 = shadowNames env (availNames avail)
avail = tyThingAvailInfo thing
-- Ugh! The new_tythings may include record selectors, since they
-- are not implicit-ids, and must appear in the TypeEnv. But they
-- will also be brought into scope by the corresponding (ATyCon
-- tc). And we want the latter, because that has the correct
-- parent (Trac #10520)
is_sub_bndr (AnId f) = case idDetails f of
RecSelId {} -> True
ClassOpId {} -> True
_ -> False
is_sub_bndr _ = False
substInteractiveContext :: InteractiveContext -> TvSubst -> InteractiveContext
substInteractiveContext ictxt@InteractiveContext{ ic_tythings = tts } subst
| isEmptyTvSubst subst = ictxt
......
:set -XRecordWildCards
data Foo = Bar { baz :: Integer } deriving Show
Bar { baz = 42 }
......@@ -222,3 +222,4 @@ test('T10322', normal, ghci_script, ['T10322.script'])
test('T10466', normal, ghci_script, ['T10466.script'])
test('T10501', normal, ghci_script, ['T10501.script'])
test('T10508', normal, ghci_script, ['T10508.script'])
test('T10520', normal, ghci_script, ['T10520.script'])
Markdown is supported
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