From 45ab7560bf233ddc7679d9a97381ee5d4cb80db6 Mon Sep 17 00:00:00 2001
From: sheaf <sam.derbyshire@gmail.com>
Date: Mon, 3 Jul 2023 17:15:49 +0200
Subject: [PATCH] Introduce greInfo, greParent

These are simple helper functions that wrap the internal
field names gre_info, gre_par.

(cherry picked from commit 6fd8f566c691b936b0b65e21700b224312611f4d)
---
 compiler/GHC/Rename/Doc.hs        |  5 ++---
 compiler/GHC/Rename/Env.hs        | 16 +++++-----------
 compiler/GHC/Rename/Expr.hs       |  2 +-
 compiler/GHC/Rename/Module.hs     |  2 +-
 compiler/GHC/Rename/Names.hs      |  2 +-
 compiler/GHC/Rename/Unbound.hs    |  2 +-
 compiler/GHC/Rename/Utils.hs      |  2 +-
 compiler/GHC/Tc/Errors/Ppr.hs     | 12 ++++++------
 compiler/GHC/Types/Name/Reader.hs | 18 ++++++++++++++----
 9 files changed, 32 insertions(+), 29 deletions(-)

diff --git a/compiler/GHC/Rename/Doc.hs b/compiler/GHC/Rename/Doc.hs
index 3fc4dd6fed1..f8499cf8c8b 100644
--- a/compiler/GHC/Rename/Doc.hs
+++ b/compiler/GHC/Rename/Doc.hs
@@ -39,9 +39,8 @@ rnHsDocIdentifiers :: GlobalRdrEnv
                    -> [Located RdrName]
                    -> [Located Name]
 rnHsDocIdentifiers gre_env ns =
-  [ L l nm
+  [ L l $ greName gre
   | L l rdr_name <- ns
   , gre <- lookupGRE_RdrName AllNameSpaces gre_env rdr_name
-  , let nm = greName gre
-  , rdrRelevantNameSpace rdr_name (nameNameSpace nm)
+  , rdrRelevantNameSpace rdr_name $ greNameSpace gre
   ]
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index 976df20bdf2..ce4a4f458fe 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -755,12 +755,12 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name ns_prio
           case original_gres of
             []  -> return NameNotFound
             [g] -> return $ IncorrectParent parent g
-                              [p | Just p <- [getParent g]]
+                              [p | ParentIs p <- [greParent g]]
             gss@(g:gss'@(_:_)) ->
               if all isRecFldGRE gss && dup_fields_ok
               then return $
                     IncorrectParent parent g
-                      [p | x <- gss, Just p <- [getParent x]]
+                      [p | x <- gss, ParentIs p <- [greParent x]]
               else mkNameClashErr $ g NE.:| gss'
 
         mkNameClashErr :: NE.NonEmpty GlobalRdrElt -> RnM ChildLookupResult
@@ -768,12 +768,6 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name ns_prio
           addNameClashErrRn rdr_name gres
           return (FoundChild (NE.head gres))
 
-        getParent :: GlobalRdrElt -> Maybe Name
-        getParent (GRE { gre_par = p } ) =
-          case p of
-            ParentIs cur_parent -> Just cur_parent
-            NoParent -> Nothing
-
         picked_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
@@ -888,7 +882,7 @@ data ChildLookupResult
 
 instance Outputable ChildLookupResult where
   ppr NameNotFound = text "NameNotFound"
-  ppr (FoundChild n) = text "Found:" <+> ppr (gre_par n) <+> ppr n
+  ppr (FoundChild n) = text "Found:" <+> ppr (greParent n) <+> ppr n
   ppr (IncorrectParent p g ns)
     = text "IncorrectParent"
       <+> hsep [ppr p, ppr $ greName g, ppr ns]
@@ -1894,7 +1888,7 @@ lookupImpDeclDeprec :: ModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn)
 lookupImpDeclDeprec iface gre
   -- Bleat if the thing, or its parent, is warn'd
   = mi_decl_warn_fn (mi_final_exts iface) (greOccName gre) `mplus`
-    case gre_par gre of
+    case greParent gre of
        ParentIs p -> mi_decl_warn_fn (mi_final_exts iface) (nameOccName p)
        NoParent   -> Nothing
 
@@ -2236,7 +2230,7 @@ lookupBindGroupOcc ctxt what rdr_name ok_ns
 
     lookup_top keep_me
       = do { env <- getGlobalRdrEnv
-           ; let all_gres = filter (ok_ns . nameNameSpace . greName)
+           ; let all_gres = filter (ok_ns . greNameSpace)
                           $ lookupGRE_OccName AllNameSpaces env (rdrNameOcc rdr_name)
                  names_in_scope = -- If rdr_name lacks a binding, only
                                   -- recommend alternatives from relevant
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index b9c7c048805..68b73d2b483 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -261,7 +261,7 @@ rnExpr (HsVar _ (L l v))
            Nothing -> rnUnboundVar v ;
            Just gre ->
     do { let nm   = greName gre
-             info = gre_info gre
+             info = greInfo gre
        ; if | IAmRecField fld_info <- info
             -- Since GHC 9.4, such occurrences of record fields must be
             -- unambiguous. For ambiguous occurrences, we arbitrarily pick one
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 1f890e35bb5..4f298e9d12c 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -1555,7 +1555,7 @@ toParents rdr_env ns
 getParent :: GlobalRdrEnv -> Name -> Name
 getParent rdr_env n
   = case lookupGRE_Name rdr_env n of
-      Just gre -> case gre_par gre of
+      Just gre -> case greParent gre of
                     ParentIs  { par_is = p } -> p
                     _                        -> n
       Nothing -> n
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index 0b650fd55e4..2baddb0646d 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -1530,7 +1530,7 @@ to a list of items, rather than a single item.
 mkChildEnv :: [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
 mkChildEnv gres = foldr add emptyNameEnv gres
   where
-    add gre env = case gre_par gre of
+    add gre env = case greParent gre of
         ParentIs  p -> extendNameEnv_Acc (:) Utils.singleton env p gre
         NoParent    -> env
 
diff --git a/compiler/GHC/Rename/Unbound.hs b/compiler/GHC/Rename/Unbound.hs
index 6fa7e6aeac3..0f8c8393092 100644
--- a/compiler/GHC/Rename/Unbound.hs
+++ b/compiler/GHC/Rename/Unbound.hs
@@ -213,7 +213,7 @@ fieldSelectorSuggestions global_env tried_rdr_name
   where
     gres = filter isNoFieldSelectorGRE
          $ lookupGRE_RdrName (IncludeFields WantField False) global_env tried_rdr_name
-    parents = [ parent | ParentIs parent <- map gre_par gres ]
+    parents = [ parent | ParentIs parent <- map greParent gres ]
 
 similarNameSuggestions :: LookingFor -> DynFlags
                        -> GlobalRdrEnv -> LocalRdrEnv
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index 3f15986c7ce..f9856522e84 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/compiler/GHC/Rename/Utils.hs
@@ -349,7 +349,7 @@ warnUnusedTopBinds gres
     = whenWOptM Opt_WarnUnusedTopBinds
     $ do env <- getGblEnv
          let isBoot = isHsBootFile $ tcg_src env
-         let noParent gre = case gre_par gre of
+         let noParent gre = case greParent gre of
                             NoParent -> True
                             _        -> False
              -- Don't warn about unused bindings with parents in
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 2f89b1c14ae..1407639cd7b 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -654,9 +654,9 @@ instance Diagnostic TcRnMessage where
           fld = quotes $ ppr (occNameFS $ greOccName gre1)
           pprSugg gre = vcat [ bullet <+> pprGRE gre <> comma
                              , nest 2 (pprNameProvenance gre) ]
-          pprGRE gre = case gre_info gre of
+          pprGRE gre = case greInfo gre of
             IAmRecField {}
-              -> let parent = par_is $ gre_par gre
+              -> let parent = par_is $ greParent gre
                  in text "record field" <+> fld <+> text "of" <+> quotes (ppr parent)
             _ -> text "variable" <+> fld
     TcRnAmbiguousRecordUpdate _rupd tc
@@ -3289,7 +3289,7 @@ dodgy_msg kind tc ie
   where
     rest :: [SDoc]
     rest =
-      case gre_info tc of
+      case greInfo tc of
         IAmTyCon ClassFlavour
           -> [ text "(in-scope) class methods or associated types" <> comma
              , text "but it has none" ]
@@ -5462,7 +5462,7 @@ pprUnusedName name reason =
 -- See #15487
 pprAmbiguousGreName :: GlobalRdrEnv -> GlobalRdrElt -> SDoc
 pprAmbiguousGreName gre_env gre
-  | IAmRecField fld_info <- gre_info gre
+  | IAmRecField fld_info <- greInfo gre
   = sep [ text "the field" <+> quotes (ppr occ) <+> parent_info fld_info <> comma
         , pprNameProvenance gre ]
   | otherwise
@@ -5475,13 +5475,13 @@ pprAmbiguousGreName gre_env gre
       case first_con of
         PatSynName  ps -> text "of pattern synonym" <+> quotes (ppr ps)
         DataConName {} ->
-          case gre_par gre of
+          case greParent gre of
             ParentIs par
               -- For a data family, only reporting the family TyCon can be
               -- unhelpful (see T23301). So we give a bit of additional
               -- info in that case.
               | Just par_gre <- lookupGRE_Name gre_env par
-              , IAmTyCon tc_flav <- gre_info par_gre
+              , IAmTyCon tc_flav <- greInfo par_gre
               , OpenFamilyFlavour IAmData _ <- tc_flav
               -> vcat [ ppr_cons
                       , text "in a data family instance of" <+> quotes (ppr par) ]
diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs
index c1d519fca3e..e2ef8f18a21 100644
--- a/compiler/GHC/Types/Name/Reader.hs
+++ b/compiler/GHC/Types/Name/Reader.hs
@@ -67,7 +67,8 @@ module GHC.Types.Name.Reader (
 
         -- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec'
         GlobalRdrEltX(..), GlobalRdrElt, IfGlobalRdrElt, FieldGlobalRdrElt,
-        greName, forceGlobalRdrEnv, hydrateGlobalRdrEnv,
+        greName, greNameSpace, greParent, greInfo,
+        forceGlobalRdrEnv, hydrateGlobalRdrEnv,
         isLocalGRE, isImportedGRE, isRecFldGRE,
         fieldGREInfo,
         isDuplicateRecFldGRE, isNoFieldSelectorGRE, isFieldSelectorGRE,
@@ -596,6 +597,15 @@ type FieldGlobalRdrElt = GlobalRdrElt
 greName :: GlobalRdrEltX info -> Name
 greName = gre_name
 
+greNameSpace :: GlobalRdrEltX info -> NameSpace
+greNameSpace = nameNameSpace . greName
+
+greParent :: GlobalRdrEltX info -> Parent
+greParent = gre_par
+
+greInfo :: GlobalRdrElt -> GREInfo
+greInfo = gre_info
+
 instance NFData IfGlobalRdrElt where
   rnf !_ = ()
 
@@ -1023,7 +1033,7 @@ fieldGRELabel = recFieldLabel . fieldGREInfo
 fieldGREInfo :: HasDebugCallStack => FieldGlobalRdrElt -> RecFieldInfo
 fieldGREInfo gre
   = assertPpr (isRecFldGRE gre) (ppr gre) $
-    case gre_info gre of
+    case greInfo gre of
       IAmRecField info -> info
       info -> pprPanic "fieldGREInfo" $
         vcat [ text "gre_name:" <+> ppr (greName gre)
@@ -1031,13 +1041,13 @@ fieldGREInfo gre
 
 recFieldConLike_maybe :: HasDebugCallStack => GlobalRdrElt -> Maybe ConInfo
 recFieldConLike_maybe gre =
-  case gre_info gre of
+  case greInfo gre of
     IAmConLike info -> Just info
     _               -> Nothing
 
 recFieldInfo_maybe :: HasDebugCallStack => GlobalRdrElt -> Maybe RecFieldInfo
 recFieldInfo_maybe gre =
-  case gre_info gre of
+  case greInfo gre of
     IAmRecField info -> assertPpr (isRecFldGRE gre) (ppr gre) $ Just info
     _                -> Nothing
 
-- 
GitLab