Make fields of GlobalRdrElt strictwip/strict-gre

In order to do this I thought it was prudent to change the list type to
a bag type to avoid doing a lot of premature work in plusGRE because of
++.

Fixes #19201

8 files changed, 50 insertions, 33 deletions

diff --git a/compiler/GHC/Data/Bag.hs b/compiler/GHC/Data/Bag.hs
index e0e43d5ad1..4171d7b03e 100644
--- a/compiler/GHC/Data/Bag.hs
+++ b/compiler/GHC/Data/Bag.hs
@@ -17,7 +17,7 @@ module GHC.Data.Bag (
         filterBag, partitionBag, partitionBagWith,
         concatBag, catBagMaybes, foldBag,
         isEmptyBag, isSingletonBag, consBag, snocBag, anyBag, allBag,
-        listToBag, nonEmptyToBag, bagToList, mapAccumBagL,
+        listToBag, nonEmptyToBag, bagToList, headMaybe, mapAccumBagL,
         concatMapBag, concatMapBagPair, mapMaybeBag,
         mapBagM, mapBagM_,
         flatMapBagM, flatMapBagPairM,
@@ -33,7 +33,7 @@ import GHC.Utils.Misc
 import GHC.Utils.Monad
 import Control.Monad
 import Data.Data
-import Data.Maybe( mapMaybe )
+import Data.Maybe( mapMaybe, listToMaybe )
 import Data.List ( partition, mapAccumL )
 import Data.List.NonEmpty ( NonEmpty(..) )
 import qualified Data.Foldable as Foldable
@@ -308,6 +308,12 @@ nonEmptyToBag (x :| xs) = ListBag (x : xs)
 bagToList :: Bag a -> [a]
 bagToList b = foldr (:) [] b
 
+headMaybe :: Bag a -> Maybe a
+headMaybe EmptyBag = Nothing
+headMaybe (UnitBag v) = Just v
+headMaybe (TwoBags b1 _) = headMaybe b1
+headMaybe (ListBag l) = listToMaybe l
+
 instance (Outputable a) => Outputable (Bag a) where
     ppr bag = braces (pprWithCommas ppr (bagToList bag))
 
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index f742e60311..3e99b18e20 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -102,6 +102,7 @@ import qualified Data.List.NonEmpty as NE
 import Control.Arrow    ( first )
 import Data.Function
 import GHC.Types.FieldLabel
+import GHC.Data.Bag
 
 {-
 *********************************************************
@@ -1568,7 +1569,7 @@ addUsedGREs gres
 
 warnIfDeprecated :: GlobalRdrElt -> RnM ()
 warnIfDeprecated gre@(GRE { gre_imp = iss })
-  | (imp_spec : _) <- iss
+  | Just imp_spec <- headMaybe iss
   = do { dflags <- getDynFlags
        ; this_mod <- getModule
        ; when (wopt Opt_WarnWarningsDeprecations dflags &&
@@ -1689,7 +1690,7 @@ lookupOneQualifiedNameGHCi fos rdr_name = do
     -- -fimplicit-import-qualified is used with a module that exports the same
     -- field name multiple times (see
     -- Note [DuplicateRecordFields and -fimplicit-import-qualified]).
-    toGRE gname = GRE { gre_name = gname, gre_par = NoParent, gre_lcl = False, gre_imp = [is] }
+    toGRE gname = GRE { gre_name = gname, gre_par = NoParent, gre_lcl = False, gre_imp = unitBag is }
     is = ImpSpec { is_decl = ImpDeclSpec { is_mod = mod, is_as = mod, is_qual = True, is_dloc = noSrcSpan }
                  , is_item = ImpAll }
     -- If -fimplicit-import-qualified succeeded, the name must be qualified.
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index 7392b76c64..c3d10a9237 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -95,6 +95,7 @@ import qualified Data.Set as S
 import System.FilePath  ((</>))
 
 import System.IO
+import GHC.Data.Bag
 
 {-
 ************************************************************************
@@ -1769,7 +1770,7 @@ mkImportMap gres
        RealSrcLoc decl_loc _ -> Map.insertWith add decl_loc [gre] imp_map
        UnhelpfulLoc _ -> imp_map
        where
-          best_imp_spec = bestImport imp_specs
+          best_imp_spec = bestImport (bagToList imp_specs)
           add _ gres = gre : gres
 
 warnUnusedImport :: WarningFlag -> NameEnv (FieldLabelString, Parent)
diff --git a/compiler/GHC/Rename/Unbound.hs b/compiler/GHC/Rename/Unbound.hs
index 7f62c11fce..6139ee8a8e 100644
--- a/compiler/GHC/Rename/Unbound.hs
+++ b/compiler/GHC/Rename/Unbound.hs
@@ -50,6 +50,7 @@ import GHC.Unit.Home.ModInfo
 
 import Data.List (sortBy, partition, nub)
 import Data.Function ( on )
+import GHC.Data.Bag
 
 {-
 ************************************************************************
@@ -263,7 +264,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env
     unquals_in_scope (gre@GRE { gre_lcl = lcl, gre_imp = is })
       | lcl       = [ Left (greDefinitionSrcSpan gre) ]
       | otherwise = [ Right ispec
-                    | i <- is, let ispec = is_decl i
+                    | i <- bagToList is, let ispec = is_decl i
                     , not (is_qual ispec) ]
 
 
@@ -272,7 +273,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env
     -- Ones for which *only* the qualified version is in scope
     quals_only (gre@GRE { gre_imp = is })
       = [ (mkRdrQual (is_as ispec) (greOccName gre), Right ispec)
-        | i <- is, let ispec = is_decl i, is_qual ispec ]
+        | i <- bagToList is, let ispec = is_decl i, is_qual ispec ]
 
 -- | Generate helpful suggestions if a qualified name Mod.foo is not in scope.
 importSuggestions :: LookingFor
@@ -422,7 +423,7 @@ qualsInScope gre@GRE { gre_lcl = lcl, gre_imp = is }
                 Nothing -> []
                 Just m  -> [(moduleName m, Left (greDefinitionSrcSpan gre))]
       | otherwise = [ (is_as ispec, Right ispec)
-                    | i <- is, let ispec = is_decl i ]
+                    | i <- bagToList is, let ispec = is_decl i ]
 
 isGreOk :: LookingFor -> GlobalRdrElt -> Bool
 isGreOk (LF what_look where_look) gre = what_ok && where_ok
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index 9642617570..fc27dac004 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/compiler/GHC/Rename/Utils.hs
@@ -65,6 +65,7 @@ import Data.List (find, sortBy)
 import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE )
 import qualified Data.List.NonEmpty as NE
 import qualified GHC.LanguageExtensions as LangExt
+import GHC.Data.Bag
 
 {-
 *********************************************************
@@ -566,7 +567,7 @@ addNameClashErrRn rdr_name gres
         pp_qual name
                 | lcl
                 = ppr (nameModule name)
-                | imp : _ <- iss  -- This 'imp' is the one that
+                | Just imp  <- headMaybe iss  -- This 'imp' is the one that
                                   -- pprNameProvenance chooses
                 , ImpDeclSpec { is_as = mod } <- is_decl imp
                 = ppr mod
diff --git a/compiler/GHC/Tc/Errors/Hole/FitTypes.hs b/compiler/GHC/Tc/Errors/Hole/FitTypes.hs
index 9c00c23cd1..70a655db45 100644
--- a/compiler/GHC/Tc/Errors/Hole/FitTypes.hs
+++ b/compiler/GHC/Tc/Errors/Hole/FitTypes.hs
@@ -42,7 +42,12 @@ instance Outputable TypedHole where
 data HoleFitCandidate = IdHFCand Id             -- An id, like locals.
                       | NameHFCand Name         -- A name, like built-in syntax.
                       | GreHFCand GlobalRdrElt  -- A global, like imported ids.
-                      deriving (Eq)
+
+instance Eq HoleFitCandidate where
+  IdHFCand i1 == IdHFCand i2 = i1 == i2
+  NameHFCand n1 == NameHFCand n2 = n1 == n2
+  GreHFCand gre1 == GreHFCand gre2 = gre_name gre1 == gre_name gre2
+  _ == _ = False
 
 instance Outputable HoleFitCandidate where
   ppr = pprHoleFitCand
diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs
index f07df72f9c..864101e8a9 100644
--- a/compiler/GHC/Types/Name/Reader.hs
+++ b/compiler/GHC/Types/Name/Reader.hs
@@ -98,6 +98,7 @@ import GHC.Types.Name.Env
 
 import Data.Data
 import Data.List( sortBy )
+import GHC.Data.Bag
 
 {-
 ************************************************************************
@@ -485,11 +486,11 @@ type GlobalRdrEnv = OccEnv [GlobalRdrElt]
 --
 -- An element of the 'GlobalRdrEnv'
 data GlobalRdrElt
-  = GRE { gre_name :: GreName      -- ^ See Note [GreNames]
-        , gre_par  :: Parent       -- ^ See Note [Parents]
-        , gre_lcl :: Bool          -- ^ True <=> the thing was defined locally
-        , gre_imp :: [ImportSpec]  -- ^ In scope through these imports
-    } deriving (Data, Eq)
+  = GRE { gre_name :: !GreName      -- ^ See Note [GreNames]
+        , gre_par  :: !Parent       -- ^ See Note [Parents]
+        , gre_lcl ::  !Bool          -- ^ True <=> the thing was defined locally
+        , gre_imp ::  !(Bag ImportSpec)  -- ^ In scope through these imports
+    } deriving (Data)
          -- INVARIANT: either gre_lcl = True or gre_imp is non-empty
          -- See Note [GlobalRdrElt provenance]
 
@@ -671,17 +672,17 @@ gresFromAvail prov_fn avail
       = case prov_fn n of  -- Nothing => bound locally
                            -- Just is => imported from 'is'
           Nothing -> GRE { gre_name = NormalGreName n, gre_par = mkParent n avail
-                         , gre_lcl = True, gre_imp = [] }
+                         , gre_lcl = True, gre_imp = emptyBag }
           Just is -> GRE { gre_name = NormalGreName n, gre_par = mkParent n avail
-                         , gre_lcl = False, gre_imp = [is] }
+                         , gre_lcl = False, gre_imp = unitBag is }
 
     mk_fld_gre fl
       = case prov_fn (flSelector fl) of  -- Nothing => bound locally
                            -- Just is => imported from 'is'
           Nothing -> GRE { gre_name = FieldGreName fl, gre_par = availParent avail
-                         , gre_lcl = True, gre_imp = [] }
+                         , gre_lcl = True, gre_imp = emptyBag }
           Just is -> GRE { gre_name = FieldGreName fl, gre_par = availParent avail
-                         , gre_lcl = False, gre_imp = [is] }
+                         , gre_lcl = False, gre_imp = unitBag is }
 
 instance HasOccName GlobalRdrElt where
   occName = greOccName
@@ -714,18 +715,18 @@ greQualModName :: GlobalRdrElt -> ModuleName
 -- Prerecondition: the greMangledName is always External
 greQualModName gre@(GRE { gre_lcl = lcl, gre_imp = iss })
  | lcl, Just mod <- greDefinitionModule gre = moduleName mod
- | (is:_) <- iss                            = is_as (is_decl is)
+ | Just is <- headMaybe iss                 = is_as (is_decl is)
  | otherwise                                = pprPanic "greQualModName" (ppr gre)
 
 greRdrNames :: GlobalRdrElt -> [RdrName]
 greRdrNames gre@GRE{ gre_lcl = lcl, gre_imp = iss }
-  = (if lcl then [unqual] else []) ++ concatMap do_spec (map is_decl iss)
+  = bagToList $ (if lcl then unitBag unqual else emptyBag) `unionBags` concatMapBag do_spec (mapBag is_decl iss)
   where
     occ    = greOccName gre
     unqual = Unqual occ
     do_spec decl_spec
-        | is_qual decl_spec = [qual]
-        | otherwise         = [unqual,qual]
+        | is_qual decl_spec = unitBag qual
+        | otherwise         = listToBag [unqual,qual]
         where qual = Qual (is_as decl_spec) occ
 
 -- the SrcSpan that pprNameProvenance prints out depends on whether
@@ -736,7 +737,7 @@ greRdrNames gre@GRE{ gre_lcl = lcl, gre_imp = iss }
 greSrcSpan :: GlobalRdrElt -> SrcSpan
 greSrcSpan gre@(GRE { gre_lcl = lcl, gre_imp = iss } )
   | lcl           = greDefinitionSrcSpan gre
-  | (is:_) <- iss = is_dloc (is_decl is)
+  | Just is <- headMaybe iss = is_dloc (is_decl is)
   | otherwise     = pprPanic "greSrcSpan" (ppr gre)
 
 mkParent :: Name -> AvailInfo -> Parent
@@ -896,7 +897,7 @@ getGRE_NameQualifier_maybes env name
   where
     qualifier_maybe (GRE { gre_lcl = lcl, gre_imp = iss })
       | lcl       = Nothing
-      | otherwise = Just $ map (is_as . is_decl) iss
+      | otherwise = Just $ map (is_as . is_decl) (bagToList iss)
 
 isLocalGRE :: GlobalRdrElt -> Bool
 isLocalGRE (GRE {gre_lcl = lcl }) = lcl
@@ -983,14 +984,14 @@ pickUnqualGRE gre@(GRE { gre_lcl = lcl, gre_imp = iss })
   | not lcl, null iss' = Nothing
   | otherwise          = Just (gre { gre_imp = iss' })
   where
-    iss' = filter unQualSpecOK iss
+    iss' = filterBag unQualSpecOK iss
 
 pickQualGRE :: ModuleName -> GlobalRdrElt -> Maybe GlobalRdrElt
 pickQualGRE mod gre@(GRE { gre_lcl = lcl, gre_imp = iss })
   | not lcl', null iss' = Nothing
   | otherwise           = Just (gre { gre_lcl = lcl', gre_imp = iss' })
   where
-    iss' = filter (qualSpecOK mod) iss
+    iss' = filterBag (qualSpecOK mod) iss
     lcl' = lcl && name_is_from mod
 
     name_is_from :: ModuleName -> Bool
@@ -1047,7 +1048,7 @@ plusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt
 plusGRE g1 g2
   = GRE { gre_name = gre_name g1
         , gre_lcl  = gre_lcl g1 || gre_lcl g2
-        , gre_imp  = gre_imp g1 ++ gre_imp g2
+        , gre_imp  = gre_imp g1 `unionBags` gre_imp g2
         , gre_par  = gre_par  g1 `plusParent` gre_par  g2 }
 
 transformGREs :: (GlobalRdrElt -> GlobalRdrElt)
@@ -1160,9 +1161,9 @@ shadowNames = minusOccEnv_C (\gres _ -> Just (mapMaybe shadow gres))
               -> Just (old_gre { gre_lcl = False, gre_imp = iss' })
 
               where
-                iss' = lcl_imp ++ mapMaybe set_qual iss
-                lcl_imp | lcl       = [mk_fake_imp_spec old_gre old_mod]
-                        | otherwise = []
+                iss' = lcl_imp `unionBags` mapMaybeBag set_qual iss
+                lcl_imp | lcl       = listToBag [mk_fake_imp_spec old_gre old_mod]
+                        | otherwise = emptyBag
 
     mk_fake_imp_spec old_gre old_mod    -- Urgh!
       = ImpSpec id_spec ImpAll
@@ -1338,7 +1339,7 @@ pprNameProvenance gre@(GRE { gre_lcl = lcl, gre_imp = iss })
                (head pp_provs)
   where
     name = greMangledName gre
-    pp_provs = pp_lcl ++ map pp_is iss
+    pp_provs = pp_lcl ++ map pp_is (bagToList iss)
     pp_lcl = if lcl then [text "defined at" <+> ppr (nameSrcLoc name)]
                     else []
     pp_is is = sep [ppr is, ppr_defn_site is name]
diff --git a/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs b/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs
index fe95cb6633..e9f504d92d 100644
--- a/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs
+++ b/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs
@@ -10,6 +10,7 @@ import GHC.Tc.Types.Constraint
 import GHC.Tc.Utils.Monad
 
 import Text.Read
+import GHC.Data.Bag
 
 
 
@@ -28,7 +29,7 @@ initPlugin _ = newTcRef $ HPS 0 Nothing
 
 fromModule :: HoleFitCandidate -> [String]
 fromModule (GreHFCand gre) =
-  map (moduleNameString . importSpecModule) $ gre_imp gre
+  map (moduleNameString . importSpecModule) $ (bagToList (gre_imp gre))
 fromModule _ = []
 
 toHoleFitCommand :: TypedHole -> String -> Maybe String