Skip to content
Snippets Groups Projects
Commit 59d7ee53 authored by mniip's avatar mniip Committed by Ben Gamari
Browse files

GHCi: Don't remove shadowed bindings from typechecker scope.

The shadowed out bindings are accessible via qualified names like
Ghci1.foo.  Since they are accessable in the renamer the typechecker
should be able to see them too.  As a consequence they show up in :show
bindings.

This fixes T11547

Test Plan:
Fixed current tests to accomodate to new stuff in :show bindings
Added a test that verifies that the typechecker doesn't crash

Reviewers: austin, bgamari, simonpj

Reviewed By: simonpj

Subscribers: simonpj, thomie

Differential Revision: https://phabricator.haskell.org/D2447

GHC Trac Issues: #11547
parent b61b7c24
No related branches found
No related tags found
No related merge requests found
......@@ -1522,7 +1522,7 @@ 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)
, ic_tythings = new_tythings ++ old_tythings
, ic_tythings = new_tythings ++ ic_tythings ictxt
, ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings
, ic_instances = ( new_cls_insts ++ old_cls_insts
, new_fam_insts ++ old_fam_insts )
......@@ -1530,8 +1530,6 @@ extendInteractiveContext ictxt new_tythings new_cls_insts new_fam_insts defaults
, ic_fix_env = fix_env -- See Note [Fixity declarations in GHCi]
}
where
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]
......@@ -1544,17 +1542,10 @@ extendInteractiveContextWithIds :: InteractiveContext -> [Id] -> InteractiveCont
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_tythings = new_tythings ++ ic_tythings ictxt
, ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings }
where
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
where
shadowed id = getOccName id `elemOccSet` new_occs
new_occs = mkOccSet (map getOccName ids)
setInteractivePackage :: HscEnv -> HscEnv
-- Set the 'thisPackage' DynFlag to 'interactive'
......
......@@ -23,6 +23,13 @@ _exception = SomeException
"foo"
"CallStack (from HasCallStack):
error, called at Test7.hs:2:18 in main:Main")
Ghci1._exception :: SomeException = SomeException
(ErrorCallWithLocation
"foo"
"CallStack (from HasCallStack):
error, called at Test7.hs:<line>:<column> in <package-id>:Main")
Ghci2._result :: a = _
Ghci3._result :: IO a = _
_result :: a = _
_exception :: SomeException = SomeException
(ErrorCallWithLocation
......
......@@ -12,6 +12,7 @@ Logged breakpoint at Test3.hs:2:22-31
_result :: [a]
f :: t -> a
xs :: [t]
Ghci1._result :: [a] = _
xs :: [t] = []
f :: t -> a = _
_result :: [a] = _
......@@ -19,7 +20,10 @@ Logged breakpoint at Test3.hs:2:18-20
_result :: a
f :: Integer -> a
x :: Integer
Ghci1._result :: [a] = _
xs :: [t] = []
Ghci2.f :: t -> a = _
Ghci2._result :: [a] = _
x :: Integer = 2
f :: Integer -> a = _
_result :: a = _
......
foo = foo
:t Ghci1.foo
foo = foo
:t Ghci2.foo
:t Ghci1.foo
data Foo = Foo | Bar
data Foo = Bar
:t Foo
:t Ghci3.Bar
Ghci1.foo :: t
Ghci2.foo :: t
Ghci1.foo :: t
Foo :: Ghci3.Foo
Ghci3.Bar :: Ghci3.Foo
test :: Integer = 0
test = 0
test :: Integer = 0
Ghci1.test :: Integer = 0
test :: [Char] = _
test = "test"
Ghci1.test :: Integer = 0
test :: [Char] = "test"
......@@ -258,6 +258,7 @@ test('T11376', normal, ghci_script, ['T11376.script'])
test('T12007', normal, ghci_script, ['T12007.script'])
test('T11975', normal, ghci_script, ['T11975.script'])
test('T10963', normal, ghci_script, ['T10963.script'])
test('T11547', normal, ghci_script, ['T11547.script'])
test('T12520', normal, ghci_script, ['T12520.script'])
test('T12091',
[expect_broken(12091), extra_run_opts('-fobject-code')],
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment