Vladislav Zavialov pushed to branch wip/int-index/subordinate-export-namespaces at Glasgow Haskell Compiler / GHC Commits: 21002761 by Vladislav Zavialov at 2025-10-24T15:38:36+03:00 Fix namespace specifiers in subordinate exports (#12488) This patch fixes an oversight in the `lookupChildrenExport` function that caused explicit namespace specifiers of subordinate export items to be ignored: module M (T (type A)) where -- should be rejected data T = A Based on the `IEWrappedName` data type, there are 5 cases to consider: 1. Unadorned name: P(X) 2. Named default: P(default X) 3. Pattern synonym: P(pattern X) 4. Type name: P(type X) 5. Data name: P(data X) Case 1 is already handled correctly; cases 2 and 3 are parse errors; and it is cases 4 and 5 that we are concerned with in this patch. Following the precedent established in `LookupExactName`, we introduce a boolean flag in `LookupChildren` to control whether to look up in all namespaces or in a specific one. If an export item is accompanied by an explicit namespace specifier `type` or `data`, we restrict the lookup in `lookupGRE` to a specific namespace. - - - - - 17 changed files: - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Types/Name/Reader.hs - + testsuite/tests/parser/should_fail/T12488c.hs - + testsuite/tests/parser/should_fail/T12488c.stderr - + testsuite/tests/parser/should_fail/T12488d.hs - + testsuite/tests/parser/should_fail/T12488d.stderr - testsuite/tests/parser/should_fail/all.T - + testsuite/tests/rename/should_compile/T12488b.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T12488a.hs - + testsuite/tests/rename/should_fail/T12488a.stderr - + testsuite/tests/rename/should_fail/T12488a_foo.hs - + testsuite/tests/rename/should_fail/T12488a_foo.stderr - + testsuite/tests/rename/should_fail/T12488e.hs - + testsuite/tests/rename/should_fail/T12488e.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -681,19 +681,20 @@ lookupGlobalOccRn will find it. -} -- | Used in export lists to lookup the children. -lookupSubBndrOcc_helper :: Bool +lookupSubBndrOcc_helper :: Bool -- ^ must have a parent + -> Bool -- ^ look up in all namespaces -> DeprecationWarnings -> ParentGRE -- ^ parent -> RdrName -- ^ thing we are looking up -> RnM ChildLookupResult -lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent_gre rdr_name +lookupSubBndrOcc_helper must_have_parent all_ns warn_if_deprec parent_gre rdr_name | isUnboundName (parentGRE_name parent_gre) -- Avoid an error cascade = return (FoundChild (mkUnboundGRERdr rdr_name)) | otherwise = do gre_env <- getGlobalRdrEnv - let original_gres = lookupGRE gre_env (LookupChildren parent_gre (rdrNameOcc rdr_name)) + let original_gres = lookupGRE gre_env (LookupChildren parent_gre (rdrNameOcc rdr_name) all_ns) picked_gres = pick_gres original_gres -- The remaining GREs are things that we *could* export here. -- Note that this includes things which have `NoParent`; @@ -846,7 +847,7 @@ lookupSubBndrOcc :: DeprecationWarnings lookupSubBndrOcc warn_if_deprec the_parent what_subordinate rdr_name = lookupExactOrOrig rdr_name (Right . greName) $ -- This happens for built-in classes, see mod052 for example - do { child <- lookupSubBndrOcc_helper True warn_if_deprec the_parent rdr_name + do { child <- lookupSubBndrOcc_helper True True warn_if_deprec the_parent rdr_name ; return $ case child of FoundChild g -> Right (greName g) NameNotFound -> Left unknown_sub ===================================== compiler/GHC/Tc/Gen/Export.hs ===================================== @@ -36,7 +36,6 @@ import GHC.Data.Maybe import GHC.Data.FastString (fsLit) import GHC.Driver.Env import GHC.Driver.DynFlags -import GHC.Parser.PostProcess ( setRdrNameSpace ) import qualified GHC.LanguageExtensions as LangExt import GHC.Types.Unique.Map @@ -792,17 +791,19 @@ lookupChildrenExport parent_gre rdr_items = mapAndReportM doOne rdr_items -> RnM (LIEWrappedName GhcRn, GlobalRdrElt) doOne n = do + let all_ns = case unLoc n of + IEName{} -> True -- Ignore the namespace iff the name is unadorned + _ -> False let bareName = (ieWrappedName . unLoc) n -- Do not report export list declaration deprecations - name <- lookupSubBndrOcc_helper False ExportDeprecationWarnings + name <- lookupSubBndrOcc_helper False all_ns ExportDeprecationWarnings (ParentGRE spec_parent (greInfo parent_gre)) bareName traceRn "lookupChildrenExport" (ppr name) - -- Default to data constructors for slightly better error - -- messages + -- Default to data namespace for slightly better error messages let unboundName :: RdrName - unboundName = if rdrNameSpace bareName == varName - then bareName - else setRdrNameSpace bareName dataName + unboundName + | all_ns = fromMaybe bareName (demoteRdrName bareName) + | otherwise = bareName case name of NameNotFound -> ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -1182,8 +1182,12 @@ data LookupGRE info where -- | Look up children 'GlobalRdrElt's with a given 'Parent'. LookupChildren - :: ParentGRE -- ^ the parent - -> OccName -- ^ the child 'OccName' to look up + :: { lookupParentGRE :: ParentGRE -- ^ the parent + , lookupChildOccName :: OccName -- ^ the child 'OccName' to look up + , lookupChildrenInAllNameSpaces :: Bool + -- ^ whether to look in *all* 'NameSpace's, or just + -- in the 'NameSpace' of the 'OccName' + } -> LookupGRE GREInfo -- | How should we look up in a 'GlobalRdrEnv'? @@ -1420,10 +1424,15 @@ lookupGRE env = \case occ = nameOccName nm lkup | all_ns = concat $ lookupOccEnv_AllNameSpaces env occ | otherwise = fromMaybe [] $ lookupOccEnv env occ - LookupChildren parent child_occ -> - let ns = occNameSpace child_occ - all_gres = concat $ lookupOccEnv_AllNameSpaces env child_occ - in highestPriorityGREs (childGREPriority parent ns) all_gres + LookupChildren { lookupParentGRE = parent + , lookupChildOccName = child_occ + , lookupChildrenInAllNameSpaces = all_ns } -> + highestPriorityGREs (childGREPriority parent ns) $ + concat $ lkup env child_occ + where + ns = occNameSpace child_occ + lkup | all_ns = lookupOccEnv_AllNameSpaces + | otherwise = lookupOccEnv_WithFields -- | Collect the 'GlobalRdrElt's with the highest priority according -- to the given function (lower value <=> higher priority). ===================================== testsuite/tests/parser/should_fail/T12488c.hs ===================================== @@ -0,0 +1,4 @@ +{-# LANGUAGE PatternSynonyms #-} +module T12488c ( T (pattern A) ) where + +data T = A \ No newline at end of file ===================================== testsuite/tests/parser/should_fail/T12488c.stderr ===================================== @@ -0,0 +1,2 @@ +T12488c.hs:2:21: error: [GHC-58481] parse error on input ‘pattern’ + ===================================== testsuite/tests/parser/should_fail/T12488d.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE NamedDefaults #-} +module T12488d ( T (default C) ) where + +class C a where + +data T = A \ No newline at end of file ===================================== testsuite/tests/parser/should_fail/T12488d.stderr ===================================== @@ -0,0 +1,2 @@ +T12488d.hs:2:21: error: [GHC-58481] parse error on input ‘default’ + ===================================== testsuite/tests/parser/should_fail/all.T ===================================== @@ -242,3 +242,5 @@ test('T25258b', normal, compile_fail, ['']) test('T25258c', normal, compile_fail, ['']) test('T25530', normal, compile_fail, ['']) test('T26418', normal, compile_fail, ['']) +test('T12488c', normal, compile_fail, ['']) +test('T12488d', normal, compile_fail, ['']) ===================================== testsuite/tests/rename/should_compile/T12488b.hs ===================================== @@ -0,0 +1,4 @@ +{-# LANGUAGE ExplicitNamespaces #-} +module T12488b ( T (data A) ) where + +data T = A ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -245,3 +245,4 @@ test('T25899a', normal, compile, ['']) test('T25899b', normal, compile, ['']) test('T25899c', [extra_files(['T25899c_helper.hs'])], multimod_compile, ['T25899c', '-v0']) test('T25899d', combined_output, ghci_script, ['T25899d.script']) +test('T12488b', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T12488a.hs ===================================== @@ -0,0 +1,4 @@ +{-# LANGUAGE ExplicitNamespaces #-} +module T12488a ( T (type A) ) where + +data T = A ===================================== testsuite/tests/rename/should_fail/T12488a.stderr ===================================== @@ -0,0 +1,5 @@ +T12488a.hs:2:18: error: [GHC-76037] + • Not in scope: type constructor or class ‘A’ + • In the export: T(type A) + Suggested fix: Perhaps use data constructor ‘A’ (line 4) + ===================================== testsuite/tests/rename/should_fail/T12488a_foo.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE TypeFamilies #-} +module T12488a_foo ( T (type A) ) where + +data T = A + +class Foo a where + type A a + foo :: a -> Int ===================================== testsuite/tests/rename/should_fail/T12488a_foo.stderr ===================================== @@ -0,0 +1,5 @@ +T12488a_foo.hs:3:22: error: [GHC-76037] + • Not in scope: type constructor or class ‘A’ + • In the export: T(type A) + Suggested fix: Perhaps use data constructor ‘A’ (line 5) + ===================================== testsuite/tests/rename/should_fail/T12488e.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE TypeFamilies #-} +module T12488e ( C (data A) ) where + +class C a where + type A a ===================================== testsuite/tests/rename/should_fail/T12488e.stderr ===================================== @@ -0,0 +1,5 @@ +T12488e.hs:3:18: error: [GHC-76037] + • Not in scope: data constructor ‘A’ + • In the export: C(data A) + Suggested fix: Perhaps use type constructor or class ‘A’ (line 6) + ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -246,3 +246,6 @@ test('T25899e1', normal, compile_fail, ['']) test('T25899e2', normal, compile_fail, ['']) test('T25899e3', [extra_files(['T25899e_helper.hs'])], multimod_compile_fail, ['T25899e3', '-v0']) test('T25899f', [extra_files(['T25899f_helper.hs'])], multimod_compile_fail, ['T25899f', '-v0']) +test('T12488a', normal, compile_fail, ['']) +test('T12488a_foo', normal, compile_fail, ['']) +test('T12488e', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/210027618405b85224187569d5c604ec... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/210027618405b85224187569d5c604ec... You're receiving this email because of your account on gitlab.haskell.org.