diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index fa0eed2344db7b5b76f4d6fdafbadeb9c5c5116f..ee0afd4e0268d7425f304eec417c7deb5a5e952f 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -1641,7 +1641,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 ++ ic_tythings ictxt + , ic_tythings = new_tythings ++ old_tythings , ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings , ic_instances = ( new_cls_insts ++ old_cls_insts , new_fam_insts ++ fam_insts ) @@ -1651,6 +1651,8 @@ 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 overridden -- See Note [Override identical instances in GHCi] @@ -1662,10 +1664,17 @@ 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 ++ ic_tythings ictxt + , ic_tythings = new_tythings ++ old_tythings , 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' diff --git a/testsuite/tests/ghci.debugger/scripts/break011.stdout b/testsuite/tests/ghci.debugger/scripts/break011.stdout index ac5b7e3a241365777dd968d47caea33af21965f2..47fb7b135de13187272f60a1947c6a3ed416f23a 100644 --- a/testsuite/tests/ghci.debugger/scripts/break011.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break011.stdout @@ -23,13 +23,6 @@ _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 diff --git a/testsuite/tests/ghci.debugger/scripts/hist001.stdout b/testsuite/tests/ghci.debugger/scripts/hist001.stdout index 523605b00a6fad46ef5d84e9f3f3899bbf1e2aec..a19a34f315f79c3995f1f2f350e5e9da21d0cd25 100644 --- a/testsuite/tests/ghci.debugger/scripts/hist001.stdout +++ b/testsuite/tests/ghci.debugger/scripts/hist001.stdout @@ -12,7 +12,6 @@ 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] = _ @@ -20,10 +19,7 @@ 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 = _ diff --git a/testsuite/tests/ghci.debugger/scripts/hist002.stdout b/testsuite/tests/ghci.debugger/scripts/hist002.stdout index 523605b00a6fad46ef5d84e9f3f3899bbf1e2aec..a19a34f315f79c3995f1f2f350e5e9da21d0cd25 100644 --- a/testsuite/tests/ghci.debugger/scripts/hist002.stdout +++ b/testsuite/tests/ghci.debugger/scripts/hist002.stdout @@ -12,7 +12,6 @@ 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] = _ @@ -20,10 +19,7 @@ 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 = _ diff --git a/testsuite/tests/ghci/scripts/T11547.script b/testsuite/tests/ghci/scripts/T11547.script deleted file mode 100644 index c4c15d6f78d9dc120db1abe10b5ea9d22863bdf8..0000000000000000000000000000000000000000 --- a/testsuite/tests/ghci/scripts/T11547.script +++ /dev/null @@ -1,9 +0,0 @@ -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 diff --git a/testsuite/tests/ghci/scripts/T11547.stdout b/testsuite/tests/ghci/scripts/T11547.stdout deleted file mode 100644 index 6f2a8333c3ab8180c6ba30c2baf422a458edf5f5..0000000000000000000000000000000000000000 --- a/testsuite/tests/ghci/scripts/T11547.stdout +++ /dev/null @@ -1,5 +0,0 @@ -Ghci1.foo :: t -Ghci2.foo :: t -Ghci1.foo :: t -Foo :: Ghci3.Foo -Ghci3.Bar :: Ghci3.Foo diff --git a/testsuite/tests/ghci/scripts/T2976.stdout b/testsuite/tests/ghci/scripts/T2976.stdout index de31112bb334ef0d13f493aaa01afa11014a21c5..9fdc11072c2584b86a7515824f60e44e98870c7c 100644 --- a/testsuite/tests/ghci/scripts/T2976.stdout +++ b/testsuite/tests/ghci/scripts/T2976.stdout @@ -1,8 +1,6 @@ test :: Integer = 0 test = 0 test :: Integer = 0 -Ghci1.test :: Integer = 0 test :: [Char] = _ test = "test" -Ghci1.test :: Integer = 0 test :: [Char] = "test" diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 016c482ffb5d00850a076cb84d9b2af717109e54..2bcdd0a9fef72c4caa8adafa30a2f03fb5dd82db 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -238,7 +238,6 @@ 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('T11721', normal, ghci_script, ['T11721.script']) test('T12520', normal, ghci_script, ['T12520.script']) test('T12091', [extra_run_opts('-fobject-code')], ghci_script,