[Git][ghc/ghc][wip/fabu/T25014-mistakenly-accepted-parent] compiler: refactors renamer lookup for sub binder occurences

Fabricio Nascimento (@fabu) gitlab at gitlab.haskell.org
Tue Jul 30 09:07:52 UTC 2024



Fabricio Nascimento pushed to branch wip/fabu/T25014-mistakenly-accepted-parent at Glasgow Haskell Compiler / GHC


Commits:
d25864be by Fabricio de Sousa Nascimento at 2024-07-30T18:07:30+09:00
compiler: refactors renamer lookup for sub binder occurences

Refactors lookupSubBndrOcc_helper into two functions that separately
deal with lookup for type classes and export lists. Removes the
Semigroup instance of DisambigInfo in favor of directly filtering
the GRE occurences, the refactored logic also fix and issue with
a program with multiple references being incorrectly accepted

Fix #25014

- - - - -


23 changed files:

- compiler/GHC/Rename/Env.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Types/Name/Reader.hs
- testsuite/tests/rename/T24452/T24452b.hs
- testsuite/tests/rename/T24452/T24452b.stderr
- testsuite/tests/rename/T24452/all.T
- + testsuite/tests/rename/T25014/Ambig1.hs
- + testsuite/tests/rename/T25014/Ambig2.hs
- + testsuite/tests/rename/T25014/T25014a.hs
- + testsuite/tests/rename/T25014/T25014a.stderr
- + testsuite/tests/rename/T25014/T25014b.hs
- + testsuite/tests/rename/T25014/T25014b.stderr
- + testsuite/tests/rename/T25014/T25014c.hs
- + testsuite/tests/rename/T25014/T25014c.stderr
- + testsuite/tests/rename/T25014/T25014d.hs
- + testsuite/tests/rename/T25014/T25014d.stderr
- + testsuite/tests/rename/T25014/T25014e.hs
- + testsuite/tests/rename/T25014/T25014f.hs
- + testsuite/tests/rename/T25014/T25014g.hs
- + testsuite/tests/rename/T25014/T25014g.stderr
- + testsuite/tests/rename/T25014/T25014h.hs
- + testsuite/tests/rename/T25014/T25014h.stderr
- + testsuite/tests/rename/T25014/all.T


Changes:

=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -32,7 +32,8 @@ module GHC.Rename.Env (
         getUpdFieldLbls,
 
         ChildLookupResult(..),
-        lookupSubBndrOcc_helper,
+        lookupChildExportListSubBndr,
+        lookupInstanceDeclarationSubBndr,
 
         HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn, lookupSigOccRnN,
         lookupSigCtxtOccRn,
@@ -113,7 +114,6 @@ import Data.Either      ( partitionEithers )
 import Data.Function    ( on )
 import Data.List        ( find, partition, groupBy, sortBy )
 import qualified Data.List.NonEmpty as NE
-import qualified Data.Semigroup as Semi
 import System.IO.Unsafe ( unsafePerformIO )
 
 {-
@@ -403,7 +403,7 @@ lookupInstDeclBndr cls what rdr
                 -- In an instance decl you aren't allowed
                 -- to use a qualified name for the method
                 -- (Although it'd make perfect sense.)
-       ; mb_name <- lookupSubBndrOcc
+       ; mb_name <- lookupInstanceDeclarationSubBndr
                           NoDeprecationWarnings
                                 -- we don't give deprecated
                                 -- warnings when a deprecated class
@@ -679,144 +679,267 @@ disambiguation anyway, because `x` is an original name, and
 lookupGlobalOccRn will find it.
 -}
 
--- | Used in export lists to lookup the children.
-lookupSubBndrOcc_helper :: Bool -> DeprecationWarnings
-                        -> Name
-                        -> RdrName -- ^ thing we are looking up
-                        -> LookupChild -- ^ how to look it up (e.g. which
-                                       -- 'NameSpace's to look in)
-                        -> RnM ChildLookupResult
-lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name how_lkup
-  | isUnboundName parent
-    -- Avoid an error cascade
-  = return (FoundChild (mkUnboundGRERdr rdr_name))
-
-  | otherwise = do
-  gre_env <- getGlobalRdrEnv
-  let original_gres = lookupGRE gre_env (LookupChildren (rdrNameOcc rdr_name) how_lkup)
-      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`.
-  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)
+{-
+Note [Renaming child GREs]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+When renaming a GRE, we sometimes make use of GRE parent information to
+disambiguate or to improve error messages. This happens in two situations:
+
+  - when renaming an export list, e.g. `T`, `fld` in `module M ( A(T, fld) )`,
+  - when renaming methods of a class instance, e.g.
+      `instance C a where { type Assoc a = Int; method a = a }`
+
+In both of these situations, we first look up all matching GREs, but then
+further refine by filtering out GREs with incorrect parents. This is done in
+pick_matching_gres, using the DisambigInfo datatype. We proceed as follows:
+
+  1. We first check if there are no matching GRE at all, and return NoOccurence.
+  2. Then we check whether there is a single matching GRE with the right parent,
+     say gre.
+     If so, return "MatchingParentOccurrence gre"
+  2. If there are multiple matching GREs with the right parent,
+     return those, using AmbiguousOccurrence.
+  3. In the absence of GREs with the right parent, we check whether there is
+     a single matching GRE, say gre.
+     If so, return "NoParentOccurrence gre".
+  5. Finally,  there are multiple matching GREs (none with the right parent),
+     return all matches, using AmbiguousOccurrence.
+
+We then consume this information slightly differently for the export case and
+for the instance method case, because for exports we can accept a GRE which has
+no parent (e.g. when bundling a pattern synonym, as per Note [Parents]
+in GHC.Types.Name.Reader), whereas for a class instance we definitely need
+the class itself to be the parent, as in the example:
+
+  import Control.Applicative ( Alternative )
+  import Data.Set ( empty )
+  instance Alternative Foo where
+    empty = ...
+
+Test cases:
+  - T11970 (both cases)
+  - T25014{a,b,c,d,e,f,g,h} (export lists)
+  - T23664, T24452{a,b,c,d,e,f} (class instances)
+-}
+lookupInstanceDeclarationSubBndr :: DeprecationWarnings
+                 -> Name     -- ^ Parent
+                 -> SDoc
+                 -> RdrName  -- ^ thing we are looking up
+                 -> RnM (Either NotInScopeError Name)
+lookupInstanceDeclarationSubBndr warn_if_deprec parent doc rdr_name =
+  lookupExactOrOrig rdr_name (Right . greName) $
+    -- This happens for built-in classes, see mod52 for example
+    do
+      let lookup_method = LookupChild { wantedParent        = parent
+                            , lookupDataConFirst  = False
+                            , prioritiseParent    = True -- See T23664.
+                            }
+      (picked_gres, _) <- pick_matching_gres parent rdr_name lookup_method
+      traceRn "lookupInstanceDeclarationSubBndr" (ppr picked_gres)
+      -- See [Mismatched class methods and associated type families]
+      -- in TcInstDecls.
+      case picked_gres of
+        MatchingParentOccurrence g -> do
+          addUsedGRE warn_if_deprec g
+          return $ Right (greName g)
+        NoOccurrence ->
+          return $ Left (UnknownSubordinate doc)
+        NoParentOccurrence _ ->
+          return $ Left (UnknownSubordinate doc)
+        AmbiguousOccurrence _ ->
+          return $ Left (UnknownSubordinate doc)
+
+-- For details, see [Renaming child GREs]
+lookupChildExportListSubBndr :: DeprecationWarnings
+                 -> Name        -- ^ Parent
+                 -> RdrName     -- ^ thing we are looking up
+                 -> LookupChild -- ^ how to look it up (e.g. which
+                                -- 'NameSpace's to look in)
+                 -> RnM ChildLookupResult
+lookupChildExportListSubBndr warn_if_deprec parent rdr_name lookup_method = do
+  (picked_gres, original_gres) <-
+    pick_matching_gres parent rdr_name lookup_method
+  traceRn "lookupChildExportListSubBndr" (ppr picked_gres)
   case picked_gres of
+    NoParentOccurrence g ->
+      success_found_child warn_if_deprec g
+    MatchingParentOccurrence g ->
+      success_found_child warn_if_deprec g
     NoOccurrence ->
-      noMatchingParentErr original_gres
-    UniqueOccurrence g ->
-      if must_have_parent
-      then noMatchingParentErr original_gres
-      else checkFld g
-    DisambiguatedOccurrence g ->
-      checkFld g
+      error_no_occurrence_after_disambiguation parent rdr_name original_gres
     AmbiguousOccurrence gres ->
-      if must_have_parent
-        -- It is more helpful to tell the user that the ambiguous matches
-        -- are for a wrong parent, then that there is a name clash,
-        -- see (#24452). Also since `gres` is NonEmpty and is a sub-list
-        -- of `original_gres` we are sure the original list is NonEmpty.
-      then mkIncorrectParentErr (NE.fromList original_gres)
-      else mkNameClashErr gres
-    where
-        checkFld :: GlobalRdrElt -> RnM ChildLookupResult
-        checkFld g = do
-          addUsedGRE warn_if_deprec g
-          return $ FoundChild g
-
-        -- Called when we find no matching GREs after disambiguation but
-        -- there are three situations where this happens.
-        -- 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.
-        --  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 "noMatchingParentErr" (ppr original_gres)
-          dup_fields_ok <- xoptM LangExt.DuplicateRecordFields
-          case original_gres of
-            []  -> return NameNotFound
-            [g] -> mkIncorrectParentErr (NE.fromList [g])
-            gss@(g:gss'@(_:_)) ->
-              if dup_fields_ok && all isRecFldGRE gss
-              then mkIncorrectParentErr (NE.fromList gss)
-              else mkNameClashErr $ g NE.:| gss'
-
-        mkIncorrectParentErr :: NE.NonEmpty GlobalRdrElt -> RnM ChildLookupResult
-        mkIncorrectParentErr gres = return $ IncorrectParent parent (NE.head gres)
-                                      [p | x <- NE.toList gres, ParentIs p <- [greParent x]]
-
-        mkNameClashErr :: NE.NonEmpty GlobalRdrElt -> RnM ChildLookupResult
-        mkNameClashErr gres = do
-          addNameClashErrRn rdr_name gres
-          return (FoundChild (NE.head gres))
-
-        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
-        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 gre
-          = case greParent gre of
-              ParentIs cur_parent
-                 | parent == cur_parent -> DisambiguatedOccurrence gre
-                 | otherwise            -> NoOccurrence
-              NoParent                  -> UniqueOccurrence gre
-{-# INLINEABLE lookupSubBndrOcc_helper #-}
+      error_name_clash rdr_name gres
+  where
+    success_found_child warn_if_deprec g = do
+      addUsedGRE warn_if_deprec g
+      return $ FoundChild g
+
+pick_matching_gres :: Name      -- Parent
+                 -> RdrName     -- ^ thing we are looking up
+                 -> LookupChild -- ^ how to look it up (e.g. which
+                                -- 'NameSpace's to look in)
+                 -> RnM (DisambigInfo, [GlobalRdrEltX GREInfo])
+pick_matching_gres parent rdr_name lookup_method = do
+  if isUnboundName parent
+    -- Avoid an error cascade, see Note [ Unbound vs Ambiguous Names ]
+  then return (MatchingParentOccurrence (mkUnboundGRERdr rdr_name), [])
+  else do
+    gre_env <- getGlobalRdrEnv
+    let lookup_chidren = LookupChildren (rdrNameOcc rdr_name) lookup_method
+        original_gres = lookupGRE gre_env lookup_chidren
+        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'.
+    traceTc "pick_matching_gres original_gres:" (ppr original_gres)
+    return (picked_gres, original_gres)
+  where
+    -- See Note [Renaming child GREs] for details of what is happening here.
+    pick_gres :: [GlobalRdrElt] -> DisambigInfo
+    pick_gres gres
+        | null no_parent_gres && null matching_parent_gres =
+          NoOccurrence
+        | [gre] <- matching_parent_gres =
+          MatchingParentOccurrence gre
+        | [gre] <- no_parent_gres, null matching_parent_gres =
+          -- Checking `null matching_parent_gres` prevents a program to compile
+          -- when there is a parent ambiguity. See T24014g
+          NoParentOccurrence gre
+        | otherwise = do
+          let all_gres = matching_parent_gres ++ no_parent_gres
+          AmbiguousOccurrence (NE.fromList all_gres)
+      where
+        resolved_gres = resolve_gres rdr_name gres
+        (matching_parent_gres, no_parent_gres) = partition_gres resolved_gres
+
+    -- foldr preserves the order of the errors as they appear in the source
+    partition_gres :: [DisambigInfo] -> ([GlobalRdrElt], [GlobalRdrElt])
+    partition_gres = foldr separate_gres_matches ([], [])
+      where
+        separate_gres_matches :: DisambigInfo -> ([GlobalRdrElt], [GlobalRdrElt]) -> ([GlobalRdrElt], [GlobalRdrElt])
+        separate_gres_matches (MatchingParentOccurrence g) (matching_parent_gres, no_parent_gres)  = (g:matching_parent_gres, no_parent_gres)
+        separate_gres_matches (NoParentOccurrence g) (matching_parent_gres, no_parent_gres) = (matching_parent_gres, g:no_parent_gres)
+        separate_gres_matches _ acc = acc
+
+    -- For Unqual, find GREs that are in scope qualified or unqualified
+    -- For Qual,   find GREs that are in scope with that qualification
+    resolve_gres :: RdrName -> [GlobalRdrElt] -> [DisambigInfo]
+    resolve_gres rdr_name gres
+      | isUnqual rdr_name  = map (match_parent parent) gres
+      | otherwise = map (match_parent parent) (pickGREs rdr_name gres)
+
+{- Note [Better errors for no matching GREs]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When GHC does not find a matching name on GREs after disambiguation
+(see [Picking and disambiguating children candidates]) it outputs an error like
+`Not in scope: ...` (NoOccurence). In some cases we can offer a better error
+by looking at the original GRE matches before disambiguation and attempt to
+surface problems that could have caused GHC to not being able to find the
+correct identifier. This is what error_no_occurrence_after_disambiguation does.
+
+1. For example where the name exists for a different parent.
+
+  module IncorrectParent (A (b)) where
+    data A = A { a :: () }
+    data B = B { b :: () }
+
+In this case instead of `Not in scope: ‘b’` we prefer the error.
+  The type constructor ‘A’ is not the parent of the record selector ‘b’ (...)
+
+2. Another case is when there is an ambiguity and we have DuplicateRecordFields.
+
+  {-# LANGUAGE DuplicateRecordFields #-}
+  module IncorrectParent (A (other)) where
+    data A = A { one :: ()   }
+    data B = B { other :: () }
+    data C = C { other :: () }
+
+we also prefer
+  The type constructor ‘A’ is not the parent of the record selector ‘other’ (...)
+
+instead of:
+   Ambiguous occurrence ‘other’.
+      It could refer to
+         either the field ‘other’ of record ‘B’ ...
+             or the field ‘other’ of record ‘C’ ...
+-}
+error_no_occurrence_after_disambiguation :: Name
+                 -> RdrName
+                 -> [GlobalRdrEltX GREInfo]
+                 -> RnM ChildLookupResult
+error_no_occurrence_after_disambiguation parent rdr_name original_gres = do
+  traceRn "error_no_matching_parent" (ppr original_gres)
+  dup_fields_ok <- xoptM LangExt.DuplicateRecordFields
+  case original_gres of
+    []  -> return NameNotFound
+    [g] -> error_incorrect_parent parent (NE.fromList [g])
+    gss@(g:gss'@(_:_)) ->
+      if dup_fields_ok && all isRecFldGRE gss
+      then error_incorrect_parent parent (NE.fromList gss)
+      else error_name_clash rdr_name $ g NE.:| gss'
+
+error_name_clash :: RdrName -> NE.NonEmpty GlobalRdrElt -> RnM ChildLookupResult
+error_name_clash rdr_name gres = do
+  addNameClashErrRn rdr_name gres
+  return (FoundChild (NE.head gres))  -- Avoid an error cascade, see Note [ Unbound vs Ambiguous Names ]
+
+error_incorrect_parent :: Name -> NE.NonEmpty GlobalRdrElt -> RnM ChildLookupResult
+error_incorrect_parent parent gres = return $ IncorrectParent parent (NE.head gres)
+                                            [p | x <- NE.toList gres, ParentIs p <- [greParent x]]
+
+
+{- Note [Disambiguating GREs by parent]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Names can occur on GRE with or without Parent. When renaming an identifier
+for example the `foo` on export `A (foo)` on the export list of the program
+below, we have the following types of matches:
+
+  {-# LANGUAGE DuplicateRecordFields #-}
+  module Matches (A (foo, Pat, bar)) where
+    import Data.Map (empty)
+
+    data A = A { foo :: () }
+    data B = B { foo :: () }
+
+    pattern Pat = ...
+
+if we are looking for `foo` in the export list `A (foo)`
+1. `A.foo` is a MatchingParentOccurrence.
+2. `B.foo` is a NoOccurrence, as it is parent B, does not match the parent A
+we are looking for.
+
+if we are looking for `Pat` in the export list `A (Pat)`
+3. `pattern Pat` is a NoParentOccurrence.
+
+The AmbiguousOccurrence arise anytime multiple NoParentOccurrences or
+MatchingOccurrences are found, see [Picking and disambiguating children candidates]
+-}
+match_parent :: Name -> GlobalRdrElt -> DisambigInfo
+match_parent parent gre
+  = case greParent gre of
+      ParentIs cur_parent
+          | parent == cur_parent -> MatchingParentOccurrence gre
+          | otherwise            -> NoOccurrence
+      NoParent                   -> NoParentOccurrence gre
 
 -- | 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 not be found, or it has the wrong parent.
-       | UniqueOccurrence GlobalRdrElt
+       | NoParentOccurrence GlobalRdrElt
           -- ^ The GRE has no parent. It could be a pattern synonym.
-       | DisambiguatedOccurrence GlobalRdrElt
-          -- ^ The parent of the GRE is the correct parent.
+       | MatchingParentOccurrence GlobalRdrElt
+          -- ^ The parent of the GRE is the correct parent. See match_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.
-
 instance Outputable DisambigInfo where
   ppr NoOccurrence = text "NoOccurrence"
-  ppr (UniqueOccurrence gre) = text "UniqueOccurrence:" <+> ppr gre
-  ppr (DisambiguatedOccurrence gre) = text "DiambiguatedOccurrence:" <+> ppr gre
+  ppr (NoParentOccurrence gre) = text "UniqueOccurrence:" <+> ppr gre
+  ppr (MatchingParentOccurrence gre) = text "MatchingParentOccurrence:"
+    <+> ppr gre
   ppr (AmbiguousOccurrence gres)    = text "Ambiguous:" <+> ppr gres
 
-instance Semi.Semigroup DisambigInfo where
-  -- These are the key lines: we prefer disambiguated occurrences to other
-  -- names.
-  _ <> DisambiguatedOccurrence g' = DisambiguatedOccurrence g'
-  DisambiguatedOccurrence g' <> _ = DisambiguatedOccurrence g'
-
-  NoOccurrence <> m = m
-  m <> NoOccurrence = m
-  UniqueOccurrence g <> UniqueOccurrence g'
-    = AmbiguousOccurrence $ g NE.:| [g']
-  UniqueOccurrence g <> AmbiguousOccurrence gs
-    = AmbiguousOccurrence (g `NE.cons` gs)
-  AmbiguousOccurrence gs <> UniqueOccurrence g'
-    = AmbiguousOccurrence (g' `NE.cons` gs)
-  AmbiguousOccurrence gs <> AmbiguousOccurrence gs'
-    = AmbiguousOccurrence (gs Semi.<> gs')
-
-instance Monoid DisambigInfo where
-  mempty = NoOccurrence
-  mappend = (Semi.<>)
-
 -- Lookup SubBndrOcc can never be ambiguous
 --
 -- Records the result of looking up a child.
@@ -829,7 +952,6 @@ data ChildLookupResult
                         [Name]        -- ^ list of possible parents
       -- | We resolved to a child
       | FoundChild GlobalRdrElt
-
 instance Outputable ChildLookupResult where
   ppr NameNotFound = text "NameNotFound"
   ppr (FoundChild n) = text "Found:" <+> ppr (greParent n) <+> ppr n
@@ -837,28 +959,6 @@ instance Outputable ChildLookupResult where
     = text "IncorrectParent"
       <+> hsep [ppr p, ppr $ greName g, ppr ns]
 
-lookupSubBndrOcc :: DeprecationWarnings
-                 -> Name     -- Parent
-                 -> SDoc
-                 -> RdrName
-                 -> RnM (Either NotInScopeError Name)
--- ^ Find all the things the 'RdrName' maps to,
--- and pick the one with the right 'Parent' 'Name'.
-lookupSubBndrOcc warn_if_deprec the_parent doc 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 what_lkup
-       ; return $ case child of
-           FoundChild g       -> Right (greName g)
-           NameNotFound       -> Left (UnknownSubordinate doc)
-           IncorrectParent {} -> Left (UnknownSubordinate doc) }
-       -- See [Mismatched class methods and associated type families]
-       -- in TcInstDecls.
-  where
-    what_lkup = LookupChild { wantedParent        = the_parent
-                            , lookupDataConFirst  = False
-                            , prioritiseParent    = True -- See T23664.
-                            }
 {-
 Note [Family instance binders]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2169,7 +2269,7 @@ lookupBindGroupOcc ctxt what rdr_name also_try_tycon_ns ns_spec
       = NE.singleton (Left err)
 
     lookup_cls_op cls
-      = NE.singleton <$> lookupSubBndrOcc AllDeprecationWarnings cls doc rdr_name
+      = NE.singleton <$> lookupInstanceDeclarationSubBndr AllDeprecationWarnings cls doc rdr_name
       where
         doc = text "method of class" <+> quotes (ppr cls)
 


=====================================
compiler/GHC/Tc/Gen/Export.hs
=====================================
@@ -654,32 +654,67 @@ If the module has NO main function:
       The IO action ‘main’ is not defined in module ‘Main’
 -}
 
+{-
+Note [Renaming children on export lists]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Renaming export lists has many corner cases, and 5 different things can appear
+in a children export list under a parent.
 
--- Renaming exports lists is a minefield. Five different things can appear in
--- children export lists ( T(A, B, C) ).
--- 1. Record selectors
--- 2. Type constructors
--- 3. Data constructors
--- 4. Pattern Synonyms
--- 5. Pattern Synonym Selectors
---
--- However, things get put into weird name spaces.
--- 1. Some type constructors are parsed as variables (-.->) for example.
--- 2. All data constructors are parsed as type constructors
--- 3. When there is ambiguity, we default type constructors to data
--- constructors and require the explicit `type` keyword for type
--- constructors.
---
--- This function first establishes the possible namespaces that an
--- identifier might be in (`choosePossibleNameSpaces`).
---
--- Then for each namespace in turn, tries to find the correct identifier
--- there returning the first positive result or the first terminating
--- error.
---
+  module M (R (s), D (MkD), Maybe (Empty), Either (Empty), pattern Px) where
+
+    -- 1. Record Selector
+    data R = R { s :: Int }
+
+    -- 2. Data Constructor
+    data D a = MkD a
+
+    -- 3. Type Constructor
+    type S = MkD Int
+
+    -- 4. Pattern Synonyms
+    class Empty a where
+      isEmpty :: a -> Bool
 
+    instance Empty (Maybe a) where
+      isEmpty Nothing = True
 
+    instance Empty (Either a b) where
+      isEmpty (Left _) = True
 
+    pattern Empty :: Empty a => a
+    pattern Empty <- (isEmpty -> True)
+
+    -- 5. Record Pattern Synonym selectors
+    data Point = Point Int Int
+
+    pattern Px :: Int -> Point
+    pattern Px{x} <- Point x _
+
+
+To makes matter more complicated:
+1. Some type constructors are parsed as variables (-.->) for example.
+2. All data constructors are parsed as type constructors
+3. When there is ambiguity, we default type constructors to data
+constructors and require the explicit `type` keyword for type
+constructors.
+4. Pattern synonyms are very flexible in which parents they can be exported with
+(see [Typing Pattern Synonym Exports]).
+
+We proceed in two steps:
+
+  1. We look up GREs, handling the possible NameSpaces to look up in.
+     See Note [Configurable GRE lookup priority].
+  2. We refine by using the GRE parent information.
+     See Note [Renaming child GREs].
+
+For more details see
+[Renaming the LHS on type class Instances],
+[Configurable GRE lookup priority] and [Picking and disambiguating children
+candidates].
+
+Also notice that this logic is similar to
+[Renaming the LHS on type class Instances]
+-}
 lookupChildrenExport :: Name -> [LIEWrappedName GhcPs]
                      -> RnM ([(LIEWrappedName GhcRn, GlobalRdrElt)])
 lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items
@@ -698,8 +733,8 @@ lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items
                   , prioritiseParent   = False -- See T11970.
                   }
 
-                -- Do not report export list declaration deprecations
-          name <-  lookupSubBndrOcc_helper False ExportDeprecationWarnings
+          -- Do not report export list declaration deprecations
+          name <-  lookupChildExportListSubBndr ExportDeprecationWarnings
                         spec_parent bareName what_lkup
           traceRn "lookupChildrenExport" (ppr name)
           -- Default to data constructors for slightly better error


=====================================
compiler/GHC/Types/Name/Reader.hs
=====================================
@@ -1215,7 +1215,7 @@ data LookupChild
     --  - @True@: prioritise getting the right 'Parent'
     --  - @False@: prioritise getting the right 'NameSpace'
     --
-    -- See Note [childGREPriority].
+    -- See Note [Configurable GRE lookup priority].
   }
 
 instance Outputable LookupChild where
@@ -1262,21 +1262,27 @@ greIsRelevant which_gres ns gre
   where
     other_ns = greNameSpace gre
 
-{- Note [childGREPriority]
-~~~~~~~~~~~~~~~~~~~~~~~~~~
+{- Note [Configurable GRE lookup priority]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 There are currently two places in the compiler where we look up GlobalRdrElts
-which have a given Parent. These are the two calls to lookupSubBndrOcc_helper:
+which have a given Parent.
 
-  A. Looking up children in an export item, e.g.
+  A. lookupChildExportListSubBndr looks up children in an export item, e.g.
 
        module M ( T(MkT, D) ) where { data T = MkT; data D = D }
 
-  B. Looking up binders in a class or instance declaration, e.g.
+     -- see [Renaming children on export lists]
+
+  B. lookupInstanceDeclarationSubBndr looks up binders in a class or
+     instance declaration, e.g.
+
      the operator +++ in the fixity declaration:
 
-       class C a where { type (+++) :: a -> a ->; infixl 6 +++ }
+       class C a where { type (+++) :: a -> a -> a; infixl 6 +++ }
        (+++) :: Int -> Int -> Int; (+++) = (+)
 
+     -- see [Renaming the LHS on type class Instances]
+
 In these two situations, there are two competing metrics for finding the "best"
 'GlobalRdrElt' that a particular 'OccName' resolves to:
 
@@ -1307,7 +1313,7 @@ Not doing so led to #23664.
 --
 -- We score by 'Parent' and 'NameSpace', with higher priorities having lower
 -- numbers. Which lexicographic order we use ('Parent' or 'NameSpace' first)
--- is determined by the first argument; see Note [childGREPriority].
+-- is determined by the first argument; see Note [Configurable GRE lookup priority].
 childGREPriority :: LookupChild -- ^ what kind of child do we want,
                                 -- e.g. what should its parent be?
                  -> NameSpace   -- ^ what 'NameSpace' are we originally looking in?
@@ -1327,7 +1333,7 @@ childGREPriority (LookupChild { wantedParent = wanted_parent
         in Just $ if par_first
                   then (par_prio, ns_prio)
                   else (ns_prio, par_prio)
-          -- See Note [childGREPriority].
+          -- See Note [Configurable GRE lookup priority].
 
   where
       -- Pick out the possible 'NameSpace's in order of priority.


=====================================
testsuite/tests/rename/T24452/T24452b.hs
=====================================
@@ -1,5 +1,4 @@
 -- Alternative.empty is not visible
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module BugReproduce where
 
 import Control.Applicative (Alternative)


=====================================
testsuite/tests/rename/T24452/T24452b.stderr
=====================================
@@ -1,2 +1,2 @@
-T24452b.hs:10:3: error: [GHC-54721]
+T24452b.hs:9:3: error: [GHC-54721]
     ‘empty’ is not a (visible) method of class ‘Alternative’
\ No newline at end of file


=====================================
testsuite/tests/rename/T24452/all.T
=====================================
@@ -3,4 +3,4 @@ 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
+test('T24452f', [extra_files(['AmbigPatSynA.hs', 'AmbigPatSynB.hs'])], multimod_compile_fail, ['T24452f','-v0'])


=====================================
testsuite/tests/rename/T25014/Ambig1.hs
=====================================
@@ -0,0 +1,5 @@
+-- A module that is ambiguous with Ambig2
+{-# LANGUAGE TypeFamilies #-}
+module Ambig1 where
+  data family T a
+  data instance T Bool = MkT


=====================================
testsuite/tests/rename/T25014/Ambig2.hs
=====================================
@@ -0,0 +1,5 @@
+-- A module that is ambiguous with Ambig1
+{-# LANGUAGE TypeFamilies #-}
+module Ambig2 where
+  import Ambig1 (T)
+  data instance T Int = MkT


=====================================
testsuite/tests/rename/T25014/T25014a.hs
=====================================
@@ -0,0 +1,5 @@
+-- Should not compile as it is unclear what gets exported
+module T25014a (T(MkT)) where
+  import Ambig1 (T(MkT))
+  import Ambig2 (T(MkT))
+  data S
\ No newline at end of file


=====================================
testsuite/tests/rename/T25014/T25014a.stderr
=====================================
@@ -0,0 +1,10 @@
+T25014a.hs:2:17: [GHC-87543]
+     Ambiguous occurrence ‘MkT’.
+      It could refer to
+         either ‘Ambig1.MkT’,
+                imported from ‘Ambig1’ at T25014a.hs:3:18-23
+                (and originally defined at Ambig1.hs:5:26-28),
+             or ‘Ambig2.MkT’,
+                imported from ‘Ambig2’ at T25014a.hs:4:18-23
+                (and originally defined at Ambig2.hs:5:25-27).
+     In the export: T(MkT)
\ No newline at end of file


=====================================
testsuite/tests/rename/T25014/T25014b.hs
=====================================
@@ -0,0 +1,4 @@
+-- Should not compile trying to export a missing name
+module T25014b (A (foo)) where
+
+data A


=====================================
testsuite/tests/rename/T25014/T25014b.stderr
=====================================
@@ -0,0 +1,3 @@
+T25014b.hs:2:17: [GHC-76037]
+     Not in scope: ‘foo’
+     In the export: A(foo)
\ No newline at end of file


=====================================
testsuite/tests/rename/T25014/T25014c.hs
=====================================
@@ -0,0 +1,8 @@
+-- Should not compile trying to export a missing name
+module T25014c (A (foo)) where
+
+data A
+
+data B = B {
+  foo :: Int
+}


=====================================
testsuite/tests/rename/T25014/T25014c.stderr
=====================================
@@ -0,0 +1,5 @@
+T25014c.hs:2:17: [GHC-88993]
+     The type constructor ‘A’ is not the parent of the record selector ‘foo’.
+      Record selectors can only be exported with their parent type constructor.
+      Parent: B
+     In the export: A(foo)
\ No newline at end of file


=====================================
testsuite/tests/rename/T25014/T25014d.hs
=====================================
@@ -0,0 +1,6 @@
+-- Should not compile trying to export a name with the wrong parent
+module T25014b (A (foo)) where
+
+data A
+
+foo = 1


=====================================
testsuite/tests/rename/T25014/T25014d.stderr
=====================================
@@ -0,0 +1,4 @@
+T25014d.hs:2:17: [GHC-88993]
+     The type constructor ‘A’ is not the parent of the identifier ‘foo’.
+      Identifiers can only be exported with their parent type constructor.
+     In the export: A(foo)
\ No newline at end of file


=====================================
testsuite/tests/rename/T25014/T25014e.hs
=====================================
@@ -0,0 +1,6 @@
+-- Should compile as A.foo matches parent
+module T25014b (A (foo)) where
+
+data A = A {
+  foo :: Int
+}


=====================================
testsuite/tests/rename/T25014/T25014f.hs
=====================================
@@ -0,0 +1,4 @@
+-- Should not compile as it is unclear what gets exported
+module T25014a (T(MkT)) where
+  import Ambig1 (T(MkT))
+  data S
\ No newline at end of file


=====================================
testsuite/tests/rename/T25014/T25014g.hs
=====================================
@@ -0,0 +1,9 @@
+-- Even though there is a single MkT without a parent, there is an ambiguity
+-- between Ambig1.T.MkT and Ambig2.T.MkT so we can't compile
+{-# LANGUAGE PatternSynonyms #-}
+
+module T25014g (T(MkT)) where
+  import Ambig1 (T(MkT))
+  import Ambig2 (T(MkT))
+
+  pattern MkT = Ambig1.MkT


=====================================
testsuite/tests/rename/T25014/T25014g.stderr
=====================================
@@ -0,0 +1,11 @@
+T25014g.hs:5:17: [GHC-87543]
+     Ambiguous occurrence ‘MkT’.
+      It could refer to
+         either ‘Ambig1.MkT’,
+                imported from ‘Ambig1’ at T25014g.hs:6:18-23
+                (and originally defined at Ambig1.hs:5:26-28),
+             or ‘Ambig2.MkT’,
+                imported from ‘Ambig2’ at T25014g.hs:7:18-23
+                (and originally defined at Ambig2.hs:5:25-27),
+              or ‘T25014g.MkT’, defined at T25014g.hs:9:3.
+    In the export: T(MkT)


=====================================
testsuite/tests/rename/T25014/T25014h.hs
=====================================
@@ -0,0 +1,8 @@
+-- A comment
+{-# LANGUAGE PatternSynonyms #-}
+
+module T25014h (T(MkT)) where
+  import Ambig1 (T(MkT))
+  import qualified Ambig1 as Am
+
+  pattern MkT = Am.MkT


=====================================
testsuite/tests/rename/T25014/T25014h.stderr
=====================================
@@ -0,0 +1,8 @@
+T25014h.hs:4:17: error: [GHC-87543]
+    Ambiguous occurrence ‘MkT’.
+      It could refer to
+         either ‘Am.MkT’,
+                imported qualified from ‘Ambig1’ at T25014h.hs:6:3-31
+                (and originally defined at Ambig1.hs:5:26-28),
+             or ‘T25014h.MkT’, defined at T25014h.hs:8:3.
+    In the export: T(MkT)
\ No newline at end of file


=====================================
testsuite/tests/rename/T25014/all.T
=====================================
@@ -0,0 +1,8 @@
+test('T25014a', [extra_files(['Ambig1.hs', 'Ambig2.hs'])], multimod_compile_fail, ['T25014a','-v0'])
+test('T25014b', [], compile_fail, [''])
+test('T25014c', [], compile_fail, [''])
+test('T25014d', [], compile_fail, [''])
+test('T25014e', [], compile, [''])
+test('T25014f', [extra_files(['Ambig1.hs', 'Ambig2.hs'])], multimod_compile, ['T25014f','-v0'])
+test('T25014g', [extra_files(['Ambig1.hs', 'Ambig2.hs'])], multimod_compile_fail, ['T25014g','-v0'])
+test('T25014h', [extra_files(['Ambig1.hs'])], multimod_compile_fail, ['T25014h','-v0'])
\ No newline at end of file



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d25864be9d1151339b2dfc3d1366b4c74f03ad31

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d25864be9d1151339b2dfc3d1366b4c74f03ad31
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/20240730/73fb2db5/attachment-0001.html>


More information about the ghc-commits mailing list