GHCi: Don't remove shadowed bindings from typechecker scope.
authormniip <mniip@mniip.com>
Sat, 1 Oct 2016 04:26:04 +0000 (00:26 -0400)
committerBen Gamari <ben@smart-cactus.org>
Sat, 1 Oct 2016 04:27:46 +0000 (00:27 -0400)
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

compiler/main/HscTypes.hs
testsuite/tests/ghci.debugger/scripts/break011.stdout
testsuite/tests/ghci.debugger/scripts/hist001.stdout
testsuite/tests/ghci/scripts/T11547.script [new file with mode: 0644]
testsuite/tests/ghci/scripts/T11547.stdout [new file with mode: 0644]
testsuite/tests/ghci/scripts/T2976.stdout
testsuite/tests/ghci/scripts/all.T

index ddeee33..127775e 100644 (file)
@@ -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'
index 47fb7b1..ac5b7e3 100644 (file)
@@ -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
index a19a34f..523605b 100644 (file)
@@ -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 = _
diff --git a/testsuite/tests/ghci/scripts/T11547.script b/testsuite/tests/ghci/scripts/T11547.script
new file mode 100644 (file)
index 0000000..c4c15d6
--- /dev/null
@@ -0,0 +1,9 @@
+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
new file mode 100644 (file)
index 0000000..6f2a833
--- /dev/null
@@ -0,0 +1,5 @@
+Ghci1.foo :: t
+Ghci2.foo :: t
+Ghci1.foo :: t
+Foo :: Ghci3.Foo
+Ghci3.Bar :: Ghci3.Foo
index 9fdc110..de31112 100644 (file)
@@ -1,6 +1,8 @@
 test :: Integer = 0
 test = 0
 test :: Integer = 0
+Ghci1.test :: Integer = 0
 test :: [Char] = _
 test = "test"
+Ghci1.test :: Integer = 0
 test :: [Char] = "test"
index 9e36567..20888ae 100755 (executable)
@@ -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')],