[Git][ghc/ghc][wip/fabu/T24452-confusing-error] compiler: Fix emitting a confusing error for non visible class method
Fabricio Nascimento (@fabu)
gitlab at gitlab.haskell.org
Wed Jun 26 01:14:54 UTC 2024
Fabricio Nascimento pushed to branch wip/fabu/T24452-confusing-error at Glasgow Haskell Compiler / GHC
Commits:
638973a7 by Fabricio de Sousa Nascimento at 2024-06-26T10:14:39+09:00
compiler: Fix emitting a confusing error for non visible class method
Changes the error message when trying to lookup names on GRE that
`must_have_parent` but we get an `AmbiguousOccurrence`. The new
behavior now points the user to the missing name, instead of the
name clash which would be unhelpful in solving their compiling issue.
Fixes #24452
- - - - -
15 changed files:
- compiler/GHC/Rename/Env.hs
- + testsuite/tests/rename/T24452/AmbigPatSynA.hs
- + testsuite/tests/rename/T24452/AmbigPatSynB.hs
- + testsuite/tests/rename/T24452/T24452a.hs
- + testsuite/tests/rename/T24452/T24452b.hs
- + testsuite/tests/rename/T24452/T24452b.stderr
- + testsuite/tests/rename/T24452/T24452c.hs
- + testsuite/tests/rename/T24452/T24452c.stderr
- + testsuite/tests/rename/T24452/T24452d.hs
- + testsuite/tests/rename/T24452/T24452d.stderr
- + testsuite/tests/rename/T24452/T24452e.hs
- + testsuite/tests/rename/T24452/T24452e.stderr
- + testsuite/tests/rename/T24452/T24452f.hs
- + testsuite/tests/rename/T24452/T24452f.stderr
- + testsuite/tests/rename/T24452/all.T
Changes:
=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -696,9 +696,10 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name how_lkup
-- The remaining GREs are things that we *could* export here.
-- Note that this includes things which have `NoParent`;
-- those are sorted in `checkPatSynParent`.
- traceRn "parent" (ppr parent)
- traceRn "lookupExportChild original_gres:" (ppr original_gres)
- traceRn "lookupExportChild picked_gres:" (ppr picked_gres $$ ppr must_have_parent)
+ traceTc "parent" (ppr parent)
+ traceTc "lookupExportChild must_have_parent:" (ppr must_have_parent)
+ traceTc "lookupExportChild original_gres:" (ppr original_gres)
+ traceTc "lookupExportChild picked_gres:" (ppr picked_gres)
case picked_gres of
NoOccurrence ->
noMatchingParentErr original_gres
@@ -709,7 +710,12 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name how_lkup
DisambiguatedOccurrence g ->
checkFld g
AmbiguousOccurrence gres ->
- mkNameClashErr gres
+ if must_have_parent
+ -- It is a more helpful to tell the user that the ambiguous
+ -- matches are for a wrong parent, then that those names clash
+ -- see (#24452).
+ then mkIncorrectParentErr original_gres
+ else mkNameClashErr gres
where
checkFld :: GlobalRdrElt -> RnM ChildLookupResult
checkFld g = do
@@ -721,25 +727,34 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name how_lkup
-- 1. There were none to begin with.
-- 2. None of the matching ones were the parent but
-- a. They were from an overloaded record field so we can report
- -- a better error
+ -- a better error.
-- b. The original lookup was actually ambiguous.
-- For example, the case where overloading is off and two
-- record fields are in scope from different record
-- constructors, neither of which is the parent.
noMatchingParentErr :: [GlobalRdrElt] -> RnM ChildLookupResult
noMatchingParentErr original_gres = do
- traceRn "npe" (ppr original_gres)
+ traceRn "noMatchingParentErr" (ppr original_gres)
dup_fields_ok <- xoptM LangExt.DuplicateRecordFields
case original_gres of
+ [] -> return NameNotFound
+ [g] -> mkIncorrectParentErr [g]
+ gss@(g:gss'@(_:_)) ->
+ if dup_fields_ok && all isRecFldGRE gss
+ then mkIncorrectParentErr gss
+ else mkNameClashErr $ g NE.:| gss'
+
+ mkIncorrectParentErr :: [GlobalRdrElt] -> RnM ChildLookupResult
+ mkIncorrectParentErr gres = return $ IncorrectParent parent g
+ [p | x <- gres, ParentIs p <- [greParent x]]
+
+ case gres of
[] -> return NameNotFound
[g] -> return $ IncorrectParent parent g
[p | ParentIs p <- [greParent g]]
- gss@(g:gss'@(_:_)) ->
- if all isRecFldGRE gss && dup_fields_ok
- then return $
- IncorrectParent parent g
+ gss@(g:_) ->
+ return $ IncorrectParent parent g
[p | x <- gss, ParentIs p <- [greParent x]]
- else mkNameClashErr $ g NE.:| gss'
mkNameClashErr :: NE.NonEmpty GlobalRdrElt -> RnM ChildLookupResult
mkNameClashErr gres = do
=====================================
testsuite/tests/rename/T24452/AmbigPatSynA.hs
=====================================
@@ -0,0 +1,4 @@
+-- A module that is ambiguous with AmbigPatSynB
+{-# LANGUAGE PatternSynonyms #-}
+module AmbigPatSynA where
+ pattern MkT{foo} = foo
\ No newline at end of file
=====================================
testsuite/tests/rename/T24452/AmbigPatSynB.hs
=====================================
@@ -0,0 +1,4 @@
+-- A module that is ambiguous with AmbigPatSynA
+{-# LANGUAGE PatternSynonyms #-}
+module AmbigPatSynB where
+ pattern MkT{foo} = foo
\ No newline at end of file
=====================================
testsuite/tests/rename/T24452/T24452a.hs
=====================================
@@ -0,0 +1,13 @@
+-- A program with empty (Alternative.empty, Map.empty, Set.empty) builds
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module BugReproduce where
+
+import Control.Applicative (Alternative (empty, (<|>)))
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+newtype Foo a = MkFoo [a] deriving (Functor, Applicative)
+
+instance Alternative Foo where
+ empty = undefined
+ p <|> q = undefined
=====================================
testsuite/tests/rename/T24452/T24452b.hs
=====================================
@@ -0,0 +1,10 @@
+-- Alternative.empty is not visible
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module BugReproduce where
+
+import Control.Applicative (Alternative)
+
+newtype Foo a = MkFoo [a] deriving (Functor, Applicative)
+
+instance Alternative Foo where
+ empty = undefined
=====================================
testsuite/tests/rename/T24452/T24452b.stderr
=====================================
@@ -0,0 +1,2 @@
+T24452b.hs:10:3: error: [GHC-54721]
+ ‘empty’ is not a (visible) method of class ‘Alternative’
\ No newline at end of file
=====================================
testsuite/tests/rename/T24452/T24452c.hs
=====================================
@@ -0,0 +1,11 @@
+-- Having Map.empty present, does not change the fact that Alternative.empty is not visible
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module BugReproduce where
+
+import Control.Applicative (Alternative)
+import qualified Data.Map as Map
+
+newtype Foo a = MkFoo [a] deriving (Functor, Applicative)
+
+instance Alternative Foo where
+ empty = undefined
=====================================
testsuite/tests/rename/T24452/T24452c.stderr
=====================================
@@ -0,0 +1,2 @@
+T24452c.hs:11:3: error: [GHC-54721]
+ ‘empty’ is not a (visible) method of class ‘Alternative’
\ No newline at end of file
=====================================
testsuite/tests/rename/T24452/T24452d.hs
=====================================
@@ -0,0 +1,12 @@
+-- Multiple other empty (Map.empty, Data.empty), but the issue still Alternative.empty not visible.
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module BugReproduce where
+
+import Control.Applicative (Alternative)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+newtype Foo a = MkFoo [a] deriving (Functor, Applicative)
+
+instance Alternative Foo where
+ empty = undefined
=====================================
testsuite/tests/rename/T24452/T24452d.stderr
=====================================
@@ -0,0 +1,2 @@
+T24452d.hs:12:3: error: [GHC-54721]
+ ‘empty’ is not a (visible) method of class ‘Alternative’
\ No newline at end of file
=====================================
testsuite/tests/rename/T24452/T24452e.hs
=====================================
@@ -0,0 +1,24 @@
+-- Multiple unrelated errors related to empty.
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedRecordUpdate #-}
+
+module T24452e where
+
+import Control.Applicative (Alternative)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+data A = A {
+ empty :: ()
+}
+data B = B {
+ empty :: ()
+}
+
+foo = empty
+
+newtype Foo a = MkFoo [a] deriving (Functor, Applicative)
+
+instance Alternative Foo where
+ empty = undefined
\ No newline at end of file
=====================================
testsuite/tests/rename/T24452/T24452e.stderr
=====================================
@@ -0,0 +1,10 @@
+T24452e.hs:19:7: error: [GHC-87543]
+ Ambiguous occurrence ‘empty’.
+ It could refer to
+ either the field ‘empty’ of record ‘A’,
+ defined at T24452e.hs:13:5,
+ or the field ‘empty’ of record ‘B’,
+ defined at T24452e.hs:16:5.
+
+T24452e.hs:24:3: error: [GHC-54721]
+ ‘empty’ is not a (visible) method of class ‘Alternative’
\ No newline at end of file
=====================================
testsuite/tests/rename/T24452/T24452f.hs
=====================================
@@ -0,0 +1,7 @@
+-- Ambiguity on the export list
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module T24452f (S(foo)) where
+ import AmbigPatSynA
+ import AmbigPatSynB
+ data S
=====================================
testsuite/tests/rename/T24452/T24452f.stderr
=====================================
@@ -0,0 +1,10 @@
+T24452f.hs:4:17: [GHC-87543]
+ Ambiguous occurrence ‘foo’.
+ It could refer to
+ either the field ‘foo’ of pattern synonym ‘AmbigPatSynA.MkT’,
+ imported from ‘AmbigPatSynA’ at T24452f.hs:5:5-23
+ (and originally defined at AmbigPatSynA.hs:4:15-17),
+ or the field ‘foo’ of pattern synonym ‘AmbigPatSynB.MkT’,
+ imported from ‘AmbigPatSynB’ at T24452f.hs:6:5-23
+ (and originally defined at AmbigPatSynB.hs:4:15-17).
+ In the export: S(foo)
\ No newline at end of file
=====================================
testsuite/tests/rename/T24452/all.T
=====================================
@@ -0,0 +1,6 @@
+test('T24452a', normal, compile, [''])
+test('T24452b', normal, compile_fail, [''])
+test('T24452c', normal, compile_fail, [''])
+test('T24452d', normal, compile_fail, [''])
+test('T24452e', normal, compile_fail, [''])
+test('T24452f', [extra_files(['AmbigPatSynA.hs', 'AmbigPatSynB.hs'])], multimod_compile_fail, ['T24452f','-v0'])
\ No newline at end of file
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/638973a77ef691e9a9a1067e4f0ba12d9395fd0d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/638973a77ef691e9a9a1067e4f0ba12d9395fd0d
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240625/84fc00ae/attachment-0001.html>
More information about the ghc-commits
mailing list