From ec3c4488f456f6f9bdd28a09f0b1e87fd3782db9 Mon Sep 17 00:00:00 2001
From: sheaf <sam.derbyshire@gmail.com>
Date: Thu, 12 Oct 2023 15:03:17 +0200
Subject: [PATCH] Combine GREs when combining in mkImportOccEnv
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
In `GHC.Rename.Names.mkImportOccEnv`, we sometimes discard one import
item in favour of another, as explained in Note [Dealing with imports]
in `GHC.Rename.Names`. However, this can cause us to lose track of
important parent information.
Consider for example #24084:
module M1 where { class C a where { type T a } }
module M2 ( module M1 ) where { import M1 }
module M3 where { import M2 ( C, T ); instance C () where T () = () }
When processing the import list of `M3`, we start off (for reasons that
are not relevant right now) with two `Avail`s attached to `T`, namely
`C(C, T)` and `T(T)`. We combine them in the `combine` function of
`mkImportOccEnv`; as described in Note [Dealing with imports] we discard
`C(C, T)` in favour of `T(T)`. However, in doing so, we **must not**
discard the information want that `C` is the parent of `T`. Indeed,
losing track of this information can cause errors when importing,
as we could get an error of the form
‘T’ is not a (visible) associated type of class ‘C’
We fix this by combining the two GREs for `T` using `plusGRE`.
Fixes #24084
---
compiler/GHC/Rename/Env.hs | 35 ++++++-----
compiler/GHC/Rename/Names.hs | 59 +++++++++++++++----
compiler/GHC/Types/Avail.hs | 2 +-
compiler/GHC/Types/Name/Reader.hs | 23 ++++++++
.../tests/rename/should_compile/T24084.hs | 11 ++++
.../tests/rename/should_compile/T24084_A.hs | 8 +++
.../tests/rename/should_compile/T24084_B.hs | 7 +++
testsuite/tests/rename/should_compile/all.T | 1 +
8 files changed, 119 insertions(+), 27 deletions(-)
create mode 100644 testsuite/tests/rename/should_compile/T24084.hs
create mode 100644 testsuite/tests/rename/should_compile/T24084_A.hs
create mode 100644 testsuite/tests/rename/should_compile/T24084_B.hs
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index 44a66634f3c9..b45dc0b63dea 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -692,13 +692,14 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name how_lkup
| otherwise = do
gre_env <- getGlobalRdrEnv
let original_gres = lookupGRE gre_env (LookupChildren (rdrNameOcc 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`.
+ picked_gres = pick_gres original_gres
+ -- 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 original_gres) $$ ppr must_have_parent)
- case picked_gres original_gres of
+ traceRn "lookupExportChild picked_gres:" (ppr picked_gres $$ ppr must_have_parent)
+ case picked_gres of
NoOccurrence ->
noMatchingParentErr original_gres
UniqueOccurrence g ->
@@ -745,34 +746,36 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name how_lkup
addNameClashErrRn rdr_name gres
return (FoundChild (NE.head gres))
- picked_gres :: [GlobalRdrElt] -> DisambigInfo
+ pick_gres :: [GlobalRdrElt] -> DisambigInfo
-- For Unqual, find GREs that are in scope qualified or unqualified
-- For Qual, find GREs that are in scope with that qualification
- picked_gres gres
+ pick_gres gres
| isUnqual rdr_name
= mconcat (map right_parent gres)
| otherwise
= mconcat (map right_parent (pickGREs rdr_name gres))
right_parent :: GlobalRdrElt -> DisambigInfo
- right_parent p
- = case greParent p of
+ right_parent gre
+ = case greParent gre of
ParentIs cur_parent
- | parent == cur_parent -> DisambiguatedOccurrence p
+ | parent == cur_parent -> DisambiguatedOccurrence gre
| otherwise -> NoOccurrence
- NoParent -> UniqueOccurrence p
+ NoParent -> UniqueOccurrence gre
{-# INLINEABLE lookupSubBndrOcc_helper #-}
--- This domain specific datatype is used to record why we decided it was
+-- | This domain specific datatype is used to record why we decided it was
-- possible that a GRE could be exported with a parent.
data DisambigInfo
= NoOccurrence
- -- The GRE could never be exported. It has the wrong parent.
+ -- ^ The GRE could not be found, or it has the wrong parent.
| UniqueOccurrence GlobalRdrElt
- -- The GRE has no parent. It could be a pattern synonym.
+ -- ^ The GRE has no parent. It could be a pattern synonym.
| DisambiguatedOccurrence GlobalRdrElt
- -- The parent of the GRE is the correct parent
+ -- ^ The parent of the GRE is the correct parent.
| AmbiguousOccurrence (NE.NonEmpty GlobalRdrElt)
+ -- ^ The GRE is ambiguous.
+ --
-- For example, two normal identifiers with the same name are in
-- scope. They will both be resolved to "UniqueOccurrence" and the
-- monoid will combine them to this failing case.
@@ -784,7 +787,7 @@ instance Outputable DisambigInfo where
ppr (AmbiguousOccurrence gres) = text "Ambiguous:" <+> ppr gres
instance Semi.Semigroup DisambigInfo where
- -- This is the key line: We prefer disambiguated occurrences to other
+ -- These are the key lines: we prefer disambiguated occurrences to other
-- names.
_ <> DisambiguatedOccurrence g' = DisambiguatedOccurrence g'
DisambiguatedOccurrence g' <> _ = DisambiguatedOccurrence g'
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index b1cb3392d6dd..99d4f6c2c50f 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -1068,13 +1068,17 @@ Notice that T appears *twice*, once as a child and once as a parent. From
these two exports, respectively, during construction of the imp_occ_env, we begin
by associating the following two elements with the key T:
- T -> ImpOccItem { imp_item = T, imp_bundled = [C,T] , imp_is_parent = False }
- T -> ImpOccItem { imp_item = T, imp_bundled = [T1,T2,T3], imp_is_parent = True }
+ T -> ImpOccItem { imp_item = gre1, imp_bundled = [C,T] , imp_is_parent = False }
+ T -> ImpOccItem { imp_item = gre2, imp_bundled = [T1,T2,T3], imp_is_parent = True }
-We combine these (in function 'combine' in 'mkImportOccEnv') by simply discarding
-the first item, to get:
+where `gre1`, `gre2` are two GlobalRdrElts with greName T.
+We combine these (in function 'combine' in 'mkImportOccEnv') by discarding the
+non-parent item, thusly:
- T -> IE_ITem { imp_item = T, imp_bundled = [T1,T2,T3], imp_is_parent = True }
+ T -> IE_ITem { imp_item = gre1 `plusGRE` gre2, imp_bundled = [T1,T2,T3], imp_is_parent = True }
+
+Note the `plusGRE`: this ensures we don't drop parent information;
+see Note [Preserve parent information when combining import OccEnvs].
So the overall imp_occ_env is:
@@ -1133,6 +1137,31 @@ Whereas in case (B) we reach the lookup_ie case for IEThingWith,
which looks up 'S' and then finds the unique 'foo' amongst its children.
See T16745 for a test of this.
+
+Note [Preserve parent information when combining import OccEnvs]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When discarding one ImpOccItem in favour of another, as described in
+Note [Dealing with imports], we must make sure to combine the GREs so that
+we don't lose information.
+
+Consider for example #24084:
+
+ module M1 where { class C a where { type T a } }
+ module M2 ( module M1 ) where { import M1 }
+ module M3 where { import M2 ( C, T ); instance C () where T () = () }
+
+When processing the import list of `M3`, we will have two `Avail`s attached
+to `T`, namely `C(C, T)` and `T(T)`. We combine them in the `combine` function
+of `mkImportOccEnv`; as described in Note [Dealing with imports] we discard
+`C(C, T)` in favour of `T(T)`. However, in doing so, we **must not**
+discard the information want that `C` is the parent of `T`. Indeed,
+losing track of this information can cause errors when importing,
+as we could get an error of the form
+
+ ‘T’ is not a (visible) associated type of class ‘C’
+
+This explains why we use `plusGRE` when combining the two ImpOccItems, even
+though we are discarding one in favour of the other.
-}
-- | All the 'GlobalRdrElt's associated with an 'AvailInfo'.
@@ -1443,6 +1472,14 @@ data ImpOccItem
-- ^ Is the import item a parent? See Note [Dealing with imports].
}
+instance Outputable ImpOccItem where
+ ppr (ImpOccItem { imp_item = item, imp_bundled = bundled, imp_is_parent = is_par })
+ = braces $ hsep
+ [ text "ImpOccItem"
+ , if is_par then text "[is_par]" else empty
+ , ppr (greName item) <+> ppr (greParent item)
+ , braces $ text "bundled:" <+> ppr (map greName bundled) ]
+
-- | Make an 'OccEnv' of all the imports.
--
-- Complicated by the fact that associated data types and pattern synonyms
@@ -1474,9 +1511,9 @@ mkImportOccEnv hsc_env decl_spec all_avails =
-- See Note [Dealing with imports]
-- 'combine' may be called for associated data types which appear
- -- twice in the all_avails. In the example, we combine
- -- T(T,T1,T2,T3) and C(C,T) to give (T, T(T,T1,T2,T3), Just C)
- -- NB: the AvailTC can have fields as well as data constructors (#12127)
+ -- twice in the all_avails. In the example, we have two Avails for T,
+ -- namely T(T,T1,T2,T3) and C(C,T), and we combine them by dropping the
+ -- latter, in which T is not the parent.
combine :: ImpOccItem -> ImpOccItem -> ImpOccItem
combine item1@(ImpOccItem { imp_item = gre1, imp_is_parent = is_parent1 })
item2@(ImpOccItem { imp_item = gre2, imp_is_parent = is_parent2 })
@@ -1484,11 +1521,13 @@ mkImportOccEnv hsc_env decl_spec all_avails =
, not (isRecFldGRE gre1 || isRecFldGRE gre2) -- NB: does not force GREInfo.
, let name1 = greName gre1
name2 = greName gre2
+ gre = gre1 `plusGRE` gre2
+ -- See Note [Preserve parent information when combining import OccEnvs]
= assertPpr (name1 == name2)
(ppr name1 <+> ppr name2) $
if is_parent1
- then item1
- else item2
+ then item1 { imp_item = gre }
+ else item2 { imp_item = gre }
-- Discard C(C,T) in favour of T(T, T1, T2, T3).
-- 'combine' may also be called for pattern synonyms which appear both
diff --git a/compiler/GHC/Types/Avail.hs b/compiler/GHC/Types/Avail.hs
index 5b8c5fd9a270..57d532f1b0dc 100644
--- a/compiler/GHC/Types/Avail.hs
+++ b/compiler/GHC/Types/Avail.hs
@@ -175,7 +175,7 @@ filterAvail keep ie rest =
-- 'avails' may have several items with the same availName
-- E.g import Ix( Ix(..), index )
-- will give Ix(Ix,index,range) and Ix(index)
--- We want to combine these; addAvail does that
+-- We want to combine these; plusAvail does that
nubAvails :: [AvailInfo] -> [AvailInfo]
nubAvails avails = eltsDNameEnv (foldl' add emptyDNameEnv avails)
where
diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs
index 0515534104f3..86d2c3ef60e0 100644
--- a/compiler/GHC/Types/Name/Reader.hs
+++ b/compiler/GHC/Types/Name/Reader.hs
@@ -76,6 +76,7 @@ module GHC.Types.Name.Reader (
-- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec'
GlobalRdrEltX(..), GlobalRdrElt, IfGlobalRdrElt, FieldGlobalRdrElt,
greName, greNameSpace, greParent, greInfo,
+ plusGRE, insertGRE,
forceGlobalRdrEnv, hydrateGlobalRdrEnv,
isLocalGRE, isImportedGRE, isRecFldGRE,
fieldGREInfo,
@@ -1165,6 +1166,17 @@ data WhichGREs info where
}
-> WhichGREs GREInfo
+instance Outputable (WhichGREs info) where
+ ppr SameNameSpace = text "SameNameSpace"
+ ppr (RelevantGREs { includeFieldSelectors = sel
+ , lookupVariablesForFields = vars
+ , lookupTyConsAsWell = tcs_too })
+ = braces $ hsep
+ [ text "RelevantGREs"
+ , text (show sel)
+ , if vars then text "[vars]" else empty
+ , if tcs_too then text "[tcs]" else empty ]
+
-- | Look up as many possibly relevant 'GlobalRdrElt's as possible.
pattern AllRelevantGREs :: WhichGREs GREInfo
pattern AllRelevantGREs =
@@ -1199,6 +1211,17 @@ data LookupChild
-- See Note [childGREPriority].
}
+instance Outputable LookupChild where
+ ppr (LookupChild { wantedParent = par
+ , lookupDataConFirst = dc
+ , prioritiseParent = prio_parent })
+ = braces $ hsep
+ [ text "LookupChild"
+ , braces (text "parent:" <+> ppr par)
+ , if dc then text "[dc_first]" else empty
+ , if prio_parent then text "[prio_parent]" else empty
+ ]
+
-- | After looking up something with the given 'NameSpace', is the resulting
-- 'GlobalRdrElt' we have obtained relevant, according to the 'RelevantGREs'
-- specification of which 'NameSpace's are relevant?
diff --git a/testsuite/tests/rename/should_compile/T24084.hs b/testsuite/tests/rename/should_compile/T24084.hs
new file mode 100644
index 000000000000..4d2657e20ccd
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T24084.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module T24084 where
+
+import T24084_B (Foo, Bar)
+
+data X
+
+instance Foo X where
+ type Bar X = X
diff --git a/testsuite/tests/rename/should_compile/T24084_A.hs b/testsuite/tests/rename/should_compile/T24084_A.hs
new file mode 100644
index 000000000000..1bb2d9da6108
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T24084_A.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE TypeFamilies #-}
+
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module T24084_A (Foo (..)) where
+
+class Foo a where
+ type Bar a
diff --git a/testsuite/tests/rename/should_compile/T24084_B.hs b/testsuite/tests/rename/should_compile/T24084_B.hs
new file mode 100644
index 000000000000..cedc614831b4
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T24084_B.hs
@@ -0,0 +1,7 @@
+
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module T24084_B (module T24084_A) where
+
+import T24084_A
+
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index cc0543278b19..c8caa1cd34b4 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -216,6 +216,7 @@ test('T23510b', normal, compile, [''])
test('T23512b', normal, compile, [''])
test('T23664', normal, compile, [''])
test('T24037', normal, compile, [''])
+test('T24084', [extra_files(['T24084_A.hs', 'T24084_B.hs'])], multimod_compile, ['T24084', '-v0'])
test('ExportWarnings1', extra_files(['ExportWarnings_base.hs', 'ExportWarnings_aux.hs']), multimod_compile, ['ExportWarnings1', '-v0 -Wno-duplicate-exports -Wx-custom'])
test('ExportWarnings2', extra_files(['ExportWarnings_base.hs', 'ExportWarnings_aux.hs', 'ExportWarnings_aux2.hs']), multimod_compile, ['ExportWarnings2', '-v0 -Wno-duplicate-exports -Wx-custom'])
test('ExportWarnings3', extra_files(['ExportWarnings_base.hs', 'ExportWarnings_aux.hs']), multimod_compile, ['ExportWarnings3', '-v0 -Wno-duplicate-exports -Wx-custom'])
--
GitLab