diff options
| -rw-r--r-- | compiler/typecheck/TcErrors.hs | 12 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnTypes.hs | 6 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_fail/T12177.hs | 5 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_fail/T12177.stderr | 28 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_fail/all.T | 1 |
5 files changed, 50 insertions, 2 deletions
diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 9cccb63059..190672904d 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -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] diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index cc940011f1..e69e115dd0 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -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 index 0000000000..4845e7f4b8 --- /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 0000000000..48bf94d2ce --- /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 41dcca751f..acc3f9f8e9 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -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 |