[Git][ghc/ghc][master] Prioritise Parent when looking up class sub-binder

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Wed Jul 19 07:36:26 UTC 2023



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00
Prioritise Parent when looking up class sub-binder

When we look up children GlobalRdrElts of a given Parent, we sometimes
would rather prioritise those GlobalRdrElts which have the right Parent,
and sometimes prioritise those that have the right NameSpace:

  - in export lists, we should prioritise NameSpace
  - for class/instance binders, we should prioritise Parent

See Note [childGREPriority] in GHC.Types.Name.Reader.

fixes #23664

- - - - -


5 changed files:

- compiler/GHC/Rename/Env.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Types/Name/Reader.hs
- + testsuite/tests/rename/should_compile/T23664.hs
- testsuite/tests/rename/should_compile/all.T


Changes:

=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -845,8 +845,10 @@ lookupSubBndrOcc warn_if_deprec the_parent doc rdr_name =
        -- See [Mismatched class methods and associated type families]
        -- in TcInstDecls.
   where
-    what_lkup = LookupChild { wantedParent       = the_parent
-                            , lookupDataConFirst = False }
+    what_lkup = LookupChild { wantedParent        = the_parent
+                            , lookupDataConFirst  = False
+                            , prioritiseParent    = True -- See T23664.
+                            }
 {-
 Note [Family instance binders]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


=====================================
compiler/GHC/Tc/Gen/Export.hs
=====================================
@@ -690,8 +690,12 @@ lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items
 
           let bareName = (ieWrappedName . unLoc) n
               what_lkup :: LookupChild
-              what_lkup = LookupChild { wantedParent       = spec_parent
-                                      , lookupDataConFirst = True }
+              what_lkup =
+                LookupChild
+                  { wantedParent       = spec_parent
+                  , lookupDataConFirst = True
+                  , prioritiseParent   = False -- See T11970.
+                  }
 
                 -- Do not report export list declaration deprecations
           name <-  lookupSubBndrOcc_helper False ExportDeprecationWarnings


=====================================
compiler/GHC/Types/Name/Reader.hs
=====================================
@@ -1190,6 +1190,13 @@ data LookupChild
   , lookupDataConFirst :: Bool
      -- ^ for type constructors, should we look in the data constructor
      -- namespace first?
+  , prioritiseParent :: Bool
+    -- ^ should we prioritise getting the right 'Parent'?
+    --
+    --  - @True@: prioritise getting the right 'Parent'
+    --  - @False@: prioritise getting the right 'NameSpace'
+    --
+    -- See Note [childGREPriority].
   }
 
 -- | After looking up something with the given 'NameSpace', is the resulting
@@ -1225,14 +1232,52 @@ greIsRelevant which_gres ns gre
   where
     other_ns = greNameSpace gre
 
+{- Note [childGREPriority]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+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:
+
+  A. Looking 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.
+     the operator +++ in the fixity declaration:
+
+       class C a where { type (+++) :: a -> a ->; infixl 6 +++ }
+       (+++) :: Int -> Int -> Int; (+++) = (+)
+
+In these two situations, there are two competing metrics for finding the "best"
+'GlobalRdrElt' that a particular 'OccName' resolves to:
+
+  - does the resolved 'GlobalRdrElt' have the correct parent?
+  - does the resolved 'GlobalRdrElt' have the same 'NameSpace' as the 'OccName'?
+
+(A) and (B) have competing requirements.
+
+For the example of (A) above, we know that the child 'D' of 'T' must live
+in the data namespace, so we look up the OccName 'OccName DataName "D"' and
+prioritise the lookup results based on the 'NameSpace'.
+This means we get an error message of the form:
+
+  The type constructor 'T' is not the parent of the data constructor 'D'.
+
+as opposed to the rather unhelpful and confusing:
+
+  The type constructor 'T' is not the parent of the type constructor 'D'.
+
+See test case T11970.
+
+For the example of (B) above, the fixity declaration for +++ lies inside the
+class, so we should prioritise looking up 'GlobalRdrElt's whose parent is 'C'.
+Not doing so led to #23664.
+-}
+
 -- | Scoring priority function for looking up children 'GlobalRdrElt'.
 --
--- First we score by 'NameSpace', with higher-priority 'NameSpace's having a
--- lower number. Then we break ties by checking if the 'Parent' is correct.
---
--- This complicated scoring function is determined by the behaviour required by
--- 'lookupChildrenExport', which requires us to look in the data constructor
--- 'NameSpace' first, for things in the type constructor 'NameSpace'.
+-- 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].
 childGREPriority :: LookupChild -- ^ what kind of child do we want,
                                 -- e.g. what should its parent be?
                  -> NameSpace   -- ^ what 'NameSpace' are we originally looking in?
@@ -1241,13 +1286,18 @@ childGREPriority :: LookupChild -- ^ what kind of child do we want,
                                 -- 'NameSpace', which is used to determine the score
                                 -- (in the first component)
                  -> Maybe (Int, Int)
-childGREPriority (LookupChild { wantedParent = wanted_parent, lookupDataConFirst = try_dc_first })
+childGREPriority (LookupChild { wantedParent = wanted_parent
+                              , lookupDataConFirst = try_dc_first
+                              , prioritiseParent = par_first })
   ns gre =
-  case child_ns_prio $ greNameSpace gre of
-    Nothing -> Nothing
-    Just np -> Just (np, parent_prio $ greParent gre)
-      -- Prioritise GREs first on NameSpace, and then on Parent.
-      -- See T11970.
+    case child_ns_prio $ greNameSpace gre of
+      Nothing -> Nothing
+      Just ns_prio ->
+        let par_prio = parent_prio $ greParent gre
+        in Just $ if par_first
+                  then (par_prio, ns_prio)
+                  else (ns_prio, par_prio)
+          -- See Note [childGREPriority].
 
   where
       -- Pick out the possible 'NameSpace's in order of priority.
@@ -1302,11 +1352,9 @@ lookupGRE env = \case
       lkup | all_ns    = concat $ lookupOccEnv_AllNameSpaces env occ
            | otherwise = fromMaybe [] $ lookupOccEnv env occ
   LookupChildren occ which_child ->
-    highestPriorityGREs (childGREPriority which_child ns) $
-      concat $ lookupOccEnv_AllNameSpaces env occ
-    where
-      ns :: NameSpace
-      ns = occNameSpace occ
+    let ns = occNameSpace occ
+        all_gres = concat $ lookupOccEnv_AllNameSpaces env occ
+    in highestPriorityGREs (childGREPriority which_child ns) all_gres
 
 -- | Collect the 'GlobalRdrElt's with the highest priority according
 -- to the given function (lower value <=> higher priority).


=====================================
testsuite/tests/rename/should_compile/T23664.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeFamilies, TypeOperators #-}
+
+module T23664 where
+
+class POrd a where
+  type a >= b
+  infix 4 >=


=====================================
testsuite/tests/rename/should_compile/all.T
=====================================
@@ -214,6 +214,7 @@ test('T23318', normal, compile, ['-Wduplicate-exports'])
 test('T23434', normal, compile, [''])
 test('T23510b', normal, compile, [''])
 test('T23512b', normal, compile, [''])
+test('T23664', normal, compile, [''])
 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'])



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3bd4d5b5482fd44914f22492877b3f3ca27299e0
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/20230719/2a5fc51e/attachment-0001.html>


More information about the ghc-commits mailing list