Hide shadowed names from `:show bindings`

Since the previous commit, all names ever defined in GHCi are in
`ic_tythings`. This is important, because they are all reachable,
although maybe in qualified form.

But for `:show bindings` it seems to be more ergonomic to only list
those bindings that are not shadowed. Or, if it is not more ergonomic,
it’s the current behavour. So let’s restore that by filtering in
`icInScopeTTs`.

Of course a single `TyThing` can be associated with many names. We keep
it it in the bindings if _any_ of its names are still visible
unqualifiedly. It's a judgement call.

4 files changed, 111 insertions, 4 deletions

diff --git a/compiler/GHC/Runtime/Context.hs b/compiler/GHC/Runtime/Context.hs
index c9f30978c0..57e95a5de8 100644
--- a/compiler/GHC/Runtime/Context.hs
+++ b/compiler/GHC/Runtime/Context.hs
@@ -30,6 +30,8 @@ import GHC.Core.FamInstEnv
 import GHC.Core.InstEnv ( ClsInst, identicalClsInstHead )
 import GHC.Core.Type
 
+import GHC.Data.Maybe ( isNothing )
+
 import GHC.Types.Avail
 import GHC.Types.Fixity.Env
 import GHC.Types.Id.Info ( IdDetails(..) )
@@ -67,7 +69,7 @@ This scheme deals well with shadowing.  For example:
 Here we must display info about constructor A, but its type T has been
 shadowed by the second declaration.  But it has a respectable
 qualified name (Ghci1.T), and its source location says where it was
-defined.
+defined, and it can also be used with the qualified name.
 
 So the main invariant continues to hold, that in any session an
 original name M.T only refers to one unique thing.  (In a previous
@@ -233,7 +235,9 @@ data InteractiveContext
 
          ic_tythings   :: [TyThing],
              -- ^ TyThings defined by the user, in reverse order of
-             -- definition (ie most recent at the front)
+             -- definition (ie most recent at the front).
+             -- Also used in GHC.Tc.Module.runTcInteractive to fill the type
+             -- checker environment.
              -- See Note [ic_tythings]
 
          ic_gre_cache :: IcGlobalRdrEnv,
@@ -322,9 +326,22 @@ icInteractiveModule (InteractiveContext { ic_mod_index = index })
   = mkInteractiveModule index
 
 -- | This function returns the list of visible TyThings (useful for
--- e.g. showBindings)
+-- e.g. showBindings).
+--
+-- It picks only those TyThings that are not shadowed by later definitions on the interpreter,
+-- to not clutter :showBindings with shadowed ids, which would show up as Ghci9.foo.
+--
+-- Some TyThings define many names; we include them if _any_ name is still
+-- available unqualified.
 icInScopeTTs :: InteractiveContext -> [TyThing]
-icInScopeTTs = ic_tythings
+icInScopeTTs ictxt = filter in_scope_unqualified (ic_tythings ictxt)
+  where
+    in_scope_unqualified thing = or
+        [ any isNothing qualifiers -- Nothing in qualifiers means available unqualified
+        | name <- concatMap availNames $ tyThingAvailInfo thing
+        , let qualifiers = getGRE_NameQualifier_maybes (icReaderEnv ictxt) name
+        ]
+
 
 -- | Get the PrintUnqualified function based on the flags and this InteractiveContext
 icPrintUnqual :: UnitEnv -> InteractiveContext -> PrintUnqualified
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index cf6633ceee..45cc94288b 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -347,3 +347,4 @@ test('T20019', normal, ghci_script, ['T20019.script'])
 test('T20101', normal, ghci_script, ['T20101.script'])
 test('T20206', normal, ghci_script, ['T20206.script'])
 test('T20455', normal, ghci_script, ['T20455.script'])
+test('shadow-bindings', normal, ghci_script, ['shadow-bindings.script'])
diff --git a/testsuite/tests/ghci/scripts/shadow-bindings.script b/testsuite/tests/ghci/scripts/shadow-bindings.script
new file mode 100644
index 0000000000..6918ad9298
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/shadow-bindings.script
@@ -0,0 +1,48 @@
+-- Exercising the behaviour of :show bindings and shadowing
+let foo = True
+foo && True
+putStrLn "Expecting foo = True"
+:show bindings
+
+let foo = False
+foo && True
+putStrLn "Expecting foo = False"
+:show bindings
+:reload
+
+data T = A | B
+:show bindings
+-- shadow T
+data T = C
+putStrLn "Expecting T and Ghci1.T"
+:show bindings
+:reload
+
+data T = A | B
+-- shadow just A and B
+data T' = A | B'
+putStrLn "Expecting T and T'"
+:show bindings
+:reload
+
+
+data T = A | B
+-- shadow all
+data T = A | B | C
+putStrLn "Expecting only T, no Ghci1.T"
+:show bindings
+:reload
+
+
+-- Now with record selectors
+data T = A {foo :: Bool}
+putStrLn "Expecting T and foo with function type"
+:show bindings
+let foo = True
+putStrLn "Expecting T and foo :: Bool"
+:show bindings
+data T = A
+putStrLn "Expecting foo, T"
+:show bindings
+
+
diff --git a/testsuite/tests/ghci/scripts/shadow-bindings.stdout b/testsuite/tests/ghci/scripts/shadow-bindings.stdout
new file mode 100644
index 0000000000..ef7d5bc9c6
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/shadow-bindings.stdout
@@ -0,0 +1,41 @@
+True
+Expecting foo = True
+foo :: Bool = True
+it :: () = ()
+False
+Expecting foo = False
+foo :: Bool = False
+it :: () = ()
+type T :: *
+data T = ...
+Expecting T and Ghci1.T
+type Ghci1.T :: *
+data Ghci1.T = ...
+type T :: *
+data T = ...
+it :: () = ()
+Expecting T and T'
+type T :: *
+data T = ...
+type T' :: *
+data T' = ...
+it :: () = ()
+Expecting only T, no Ghci1.T
+type T :: *
+data T = ...
+it :: () = ()
+Expecting T and foo with function type
+type T :: *
+data T = ...
+foo :: T -> Bool = _
+it :: () = ()
+Expecting T and foo :: Bool
+type T :: *
+data T = ...
+foo :: Bool = True
+it :: () = ()
+Expecting foo, T
+foo :: Bool = True
+type T :: *
+data T = ...
+it :: () = ()