[commit: ghc] master: GHCi: Don't remove shadowed bindings from typechecker scope. (59d7ee5)

git at git.haskell.org git at git.haskell.org
Sat Oct 1 21:50:40 UTC 2016


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/59d7ee53906b9cee7f279c1f9567af7b930f8636/ghc

>---------------------------------------------------------------

commit 59d7ee53906b9cee7f279c1f9567af7b930f8636
Author: mniip <mniip at mniip.com>
Date:   Sat Oct 1 00:26:04 2016 -0400

    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


>---------------------------------------------------------------

59d7ee53906b9cee7f279c1f9567af7b930f8636
 compiler/main/HscTypes.hs                             | 13 ++-----------
 testsuite/tests/ghci.debugger/scripts/break011.stdout |  7 +++++++
 testsuite/tests/ghci.debugger/scripts/hist001.stdout  |  4 ++++
 testsuite/tests/ghci/scripts/T11547.script            |  9 +++++++++
 testsuite/tests/ghci/scripts/T11547.stdout            |  5 +++++
 testsuite/tests/ghci/scripts/T2976.stdout             |  2 ++
 testsuite/tests/ghci/scripts/all.T                    |  1 +
 7 files changed, 30 insertions(+), 11 deletions(-)

diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index ddeee33..127775e 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -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'
diff --git a/testsuite/tests/ghci.debugger/scripts/break011.stdout b/testsuite/tests/ghci.debugger/scripts/break011.stdout
index 47fb7b1..ac5b7e3 100644
--- a/testsuite/tests/ghci.debugger/scripts/break011.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/break011.stdout
@@ -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
diff --git a/testsuite/tests/ghci.debugger/scripts/hist001.stdout b/testsuite/tests/ghci.debugger/scripts/hist001.stdout
index a19a34f..523605b 100644
--- a/testsuite/tests/ghci.debugger/scripts/hist001.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/hist001.stdout
@@ -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
index 0000000..c4c15d6
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T11547.script
@@ -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
index 0000000..6f2a833
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T11547.stdout
@@ -0,0 +1,5 @@
+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 9fdc110..de31112 100644
--- a/testsuite/tests/ghci/scripts/T2976.stdout
+++ b/testsuite/tests/ghci/scripts/T2976.stdout
@@ -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"
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 9e36567..20888ae 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -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')],



More information about the ghc-commits mailing list