[commit: ghc] ghc-8.0: Relevant Bindings no longer reports shadowed bindings (fixes #12176) (88b7812)

[git at git.haskell.org]

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

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/88b781283b728f72f2fcbae82037dd3d7f407e7a/ghc

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

commit 88b781283b728f72f2fcbae82037dd3d7f407e7a
Author: Annie Cherkaev <annie.cherk at gmail.com>
Date:   Sun Jul 31 23:30:42 2016 -0700

    Relevant Bindings no longer reports shadowed bindings (fixes #12176)
    
    Summary: Modified the RelevantBindings method in TcErrors.hs to only search over
    non-shadowed bindings.
    
    Test Plan: Wrote 2 simple test cases, verified that it worked with multiple
    shadowed bindings, and also non-shadowed bindings.
    
    Reviewers: austin, bgamari, ezyang
    
    Reviewed By: ezyang
    
    Subscribers: ezyang, thomie
    
    Differential Revision: https://phabricator.haskell.org/D2434
    
    GHC Trac Issues: #12177
    
    (cherry picked from commit 89ae1e858f6eed42cebd9af01b30e239d4543faf)


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

88b781283b728f72f2fcbae82037dd3d7f407e7a
 compiler/typecheck/TcErrors.hs                     | 12 +++++++++-
 compiler/typecheck/TcRnTypes.hs                    |  4 ++++
 testsuite/tests/typecheck/should_fail/T12177.hs    |  5 ++++
 .../tests/typecheck/should_fail/T12177.stderr      | 28 ++++++++++++++++++++++
 testsuite/tests/typecheck/should_fail/all.T        |  1 +
 5 files changed, 49 insertions(+), 1 deletion(-)

diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs
index 43c2571..60144c6 100644
--- a/compiler/typecheck/TcErrors.hs
+++ b/compiler/typecheck/TcErrors.hs
@@ -2517,7 +2517,7 @@ relevantBindings want_filtering ctxt ct
        ; (tidy_env', docs, discards)
               <- go env1 ct_tvs (maxRelevantBinds dflags)
                     emptyVarSet [] False
-                    (tcl_bndrs lcl_env)
+                    (remove_shadowing $ tcl_bndrs lcl_env)
          -- tcl_bndrs has the innermost bindings first,
          -- which are probably the most relevant ones
 
@@ -2543,6 +2543,16 @@ relevantBindings want_filtering ctxt ct
     dec_max :: Maybe Int -> Maybe Int
     dec_max = fmap (\n -> n - 1)
 
+    ---- fixes #12177
+    ---- builds up a list of bindings whose OccName has not been seen before
+    remove_shadowing :: [TcIdBinder] -> [TcIdBinder]
+    remove_shadowing bindings = reverse $ fst $ foldl
+      (\(bindingAcc, seenNames) binding ->
+        if (occName binding) `elemOccSet` seenNames -- if we've seen it
+          then (bindingAcc, seenNames)              -- skip it
+          else (binding:bindingAcc, extendOccSet seenNames (occName binding)))
+      ([], emptyOccSet) bindings
+
     go :: TidyEnv -> TcTyVarSet -> Maybe Int -> TcTyVarSet -> [SDoc]
        -> Bool                          -- True <=> some filtered out due to lack of fuel
        -> [TcIdBinder]
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index d48d6a7..72a8222 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -777,6 +777,10 @@ instance Outputable TcIdBinder where
    ppr (TcIdBndr id top_lvl)           = ppr id <> brackets (ppr top_lvl)
    ppr (TcIdBndr_ExpType id _ top_lvl) = ppr id <> brackets (ppr top_lvl)
 
+instance HasOccName TcIdBinder where
+    occName (TcIdBndr id _) = (occName (idName id))
+    occName (TcIdBndr_ExpType name _ _) = (occName name)
+
 ---------------------------
 -- Template Haskell stages and levels
 ---------------------------
diff --git a/testsuite/tests/typecheck/should_fail/T12177.hs b/testsuite/tests/typecheck/should_fail/T12177.hs
new file mode 100644
index 0000000..4845e7f
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T12177.hs
@@ -0,0 +1,5 @@
+module Foo where
+
+bar = \x -> \x -> _
+
+baz = \x -> \y -> \z -> \x -> \z -> _
diff --git a/testsuite/tests/typecheck/should_fail/T12177.stderr b/testsuite/tests/typecheck/should_fail/T12177.stderr
new file mode 100644
index 0000000..48bf94d
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T12177.stderr
@@ -0,0 +1,28 @@
+
+T12177.hs:3:19: error:
+    • Found hole: _ :: t
+      Where: ‘t’ is a rigid type variable bound by
+               the inferred type of bar :: t2 -> t1 -> t
+               at T12177.hs:3:1-19
+    • In the expression: _
+      In the expression: \ x -> _
+      In the expression: \ x -> \ x -> _
+    • Relevant bindings include
+        x :: t1 (bound at T12177.hs:3:14)
+        bar :: t2 -> t1 -> t (bound at T12177.hs:3:1)
+
+T12177.hs:5:37: error:
+    • Found hole: _ :: t
+      Where: ‘t’ is a rigid type variable bound by
+               the inferred type of baz :: t5 -> t4 -> t3 -> t2 -> t1 -> t
+               at T12177.hs:5:1-37
+    • In the expression: _
+      In the expression: \ z -> _
+      In the expression: \ x -> \ z -> _
+    • Relevant bindings include
+        z :: t1 (bound at T12177.hs:5:32)
+        x :: t2 (bound at T12177.hs:5:26)
+        y :: t4 (bound at T12177.hs:5:14)
+        baz :: t5 -> t4 -> t3 -> t2 -> t1 -> t
+          (bound at T12177.hs:5:1)
+          
\ No newline at end of file
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 3880287..534626a 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -420,3 +420,4 @@ test('T7437', normal, compile_fail, [''])
 test('T11947a', normal, compile_fail, [''])
 test('T11974b', normal, compile_fail, [''])
 test('T12406', normal, compile_fail, [''])
+test('T12177', normal, compile_fail, [''])