Relevant Bindings no longer reports shadowed bindings (fixes #12176)
authorAnnie Cherkaev <annie.cherk@gmail.com>
Mon, 1 Aug 2016 06:30:42 +0000 (23:30 -0700)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Mon, 1 Aug 2016 08:36:05 +0000 (01:36 -0700)
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

compiler/typecheck/TcErrors.hs
compiler/typecheck/TcRnTypes.hs
testsuite/tests/typecheck/should_fail/T12177.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/T12177.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/all.T

index 9cccb63..1906729 100644 (file)
@@ -2546,7 +2546,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
 
@@ -2572,6 +2572,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]
index cc94001..e69e115 100644 (file)
@@ -142,7 +142,7 @@ import Coercion ( Coercion, mkHoleCo )
 import ConLike  ( ConLike(..) )
 import DataCon  ( DataCon, dataConUserType, dataConOrigArgTys )
 import PatSyn   ( PatSyn, pprPatSynType )
-import Id       ( idType )
+import Id       ( idType, idName )
 import FieldLabel ( FieldLabel )
 import TcType
 import Annotations
@@ -779,6 +779,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 (file)
index 0000000..4845e7f
--- /dev/null
@@ -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 (file)
index 0000000..48bf94d
--- /dev/null
@@ -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
index 41dcca7..acc3f9f 100644 (file)
@@ -423,3 +423,4 @@ test('T12063', [ expect_broken(12063), extra_clean(['T12063.hi-boot', 'T12063.o-
 test('T11974b', normal, compile_fail, [''])
 test('T12151', normal, compile_fail, [''])
 test('T7437', normal, compile_fail, [''])
+test('T12177', normal, compile_fail, [''])
\ No newline at end of file