[commit: ghc] master: GHCi: fix scoping for record selectors (a3f6239)
git at git.haskell.org
git at git.haskell.org
Mon Jun 15 13:23:29 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/a3f6239d905ad4b8fb597f43bd4ef9947c83362f/ghc
>---------------------------------------------------------------
commit a3f6239d905ad4b8fb597f43bd4ef9947c83362f
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Mon Jun 15 13:32:48 2015 +0100
GHCi: fix scoping for record selectors
This fixes Trac #10520. See the "Ugh" note about
record selectors in HscTypes.icExtendGblRdrEnv.
>---------------------------------------------------------------
a3f6239d905ad4b8fb597f43bd4ef9947c83362f
compiler/main/HscMain.hs | 19 +++++++-------
compiler/main/HscTypes.hs | 41 ++++++++++++++++++++----------
testsuite/tests/ghci/scripts/T10520.script | 3 +++
testsuite/tests/ghci/scripts/T10520.stdout | 1 +
testsuite/tests/ghci/scripts/all.T | 1 +
5 files changed, 42 insertions(+), 23 deletions(-)
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 2708396..94896b0 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -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
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 67b0694..c2a5153 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -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
- | 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 }
+-- 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 at InteractiveContext{ ic_tythings = tts } subst
| isEmptyTvSubst subst = ictxt
diff --git a/testsuite/tests/ghci/scripts/T10520.script b/testsuite/tests/ghci/scripts/T10520.script
new file mode 100644
index 0000000..d72491c
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T10520.script
@@ -0,0 +1,3 @@
+:set -XRecordWildCards
+data Foo = Bar { baz :: Integer } deriving Show
+Bar { baz = 42 }
diff --git a/testsuite/tests/ghci/scripts/T10520.stdout b/testsuite/tests/ghci/scripts/T10520.stdout
new file mode 100644
index 0000000..8fe2823
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T10520.stdout
@@ -0,0 +1 @@
+Bar {baz = 42}
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index c2c75ec..4094a9e 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -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'])
More information about the ghc-commits
mailing list