Experiment: Split [GlobalRdrElt] into also-unqualified and only-qualifiedwip/joachim/split-GlobalRdrElts

crude refactoring so far.

10 files changed, 119 insertions, 77 deletions

diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index f742e60311..6ba221d8e9 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -325,7 +325,7 @@ lookupExactOcc_either name
                               Just occ -> [occ]
                               Nothing  -> []
              gres = [ gre | occ <- main_occ : demoted_occs
-                          , gre <- lookupGlobalRdrEnv env occ
+                          , gre <- greEntryToList (lookupGlobalRdrEnv env occ)
                           , greMangledName gre == name ]
        ; case gres of
            [gre] -> return (Right (greMangledName gre))
@@ -519,7 +519,7 @@ lookupRecFieldOcc mb_con rdr_name
                            -- GRE so we get import usage right (see #17853).
                            gre <- lookupGRE_FieldLabel env fl
                            if isQual rdr_name
-                             then do gre' <- listToMaybe (pickGREs rdr_name [gre])
+                             then do gre' <- listToMaybe (pickGREs rdr_name (singletonGreEntry gre))
                                      return (fl, gre')
                               else return (fl, gre)
        ; case mb_field of
@@ -701,13 +701,13 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name
   -- this includes things which have `NoParent`. Those are sorted in
   -- `checkPatSynParent`.
   traceRn "parent" (ppr parent)
-  traceRn "lookupExportChild original_gres:" (ppr original_gres)
+  traceRn "lookupExportChild original_gres:" (ppr (greEntryToList original_gres))
   traceRn "lookupExportChild picked_gres:" (ppr (picked_gres original_gres) $$ ppr must_have_parent)
   case picked_gres original_gres of
     NoOccurrence ->
-      noMatchingParentErr original_gres
+      noMatchingParentErr (greEntryToList original_gres)
     UniqueOccurrence g ->
-      if must_have_parent then noMatchingParentErr original_gres
+      if must_have_parent then noMatchingParentErr (greEntryToList original_gres)
                           else checkFld g
     DisambiguatedOccurrence g ->
       checkFld g
@@ -758,12 +758,12 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name
             ParentIs cur_parent -> Just cur_parent
             NoParent -> Nothing
 
-        picked_gres :: [GlobalRdrElt] -> DisambigInfo
+        picked_gres :: GreEntry -> DisambigInfo
         -- For Unqual, find GREs that are in scope qualified or unqualified
         -- For Qual,   find GREs that are in scope with that qualification
         picked_gres gres
           | isUnqual rdr_name
-          = mconcat (map right_parent gres)
+          = mconcat (map right_parent (greEntryToList gres))
           | otherwise
           = mconcat (map right_parent (pickGREs rdr_name gres))
 
@@ -1875,7 +1875,7 @@ lookupBindGroupOcc ctxt what rdr_name
     lookup_top keep_me
       = do { env <- getGlobalRdrEnv
            ; dflags <- getDynFlags
-           ; let all_gres = lookupGlobalRdrEnv env (rdrNameOcc rdr_name)
+           ; let all_gres = greEntryToList (lookupGlobalRdrEnv env (rdrNameOcc rdr_name))
                  names_in_scope = -- If rdr_name lacks a binding, only
                                   -- recommend alternatives from related
                                   -- namespaces. See #17593.
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index 7392b76c64..41d72a3fb0 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -705,7 +705,7 @@ extendGlobalRdrEnvRn avails new_fixities
       = return (extendGlobalRdrEnv env gre)
       where
         -- See Note [Reporting duplicate local declarations]
-        dups = filter isDupGRE (lookupGlobalRdrEnv env (greOccName gre))
+        dups = filter isDupGRE (greEntryToList (lookupGlobalRdrEnv env (greOccName gre)))
         isDupGRE gre' = isLocalGRE gre' && not (isAllowedDup gre')
         isAllowedDup gre' =
             case (isRecFldGRE gre, isRecFldGRE gre') of
diff --git a/compiler/GHC/Rename/Unbound.hs b/compiler/GHC/Rename/Unbound.hs
index 7f62c11fce..1c86624def 100644
--- a/compiler/GHC/Rename/Unbound.hs
+++ b/compiler/GHC/Rename/Unbound.hs
@@ -384,7 +384,7 @@ importSuggestions looking_for global_env hpt currMod imports rdr_name
   -- wouldn't have an out-of-scope error in the first place)
   helpful_imports = filter helpful interesting_imports
     where helpful (_,imv)
-            = any (isGreOk looking_for) $
+            = any (isGreOk looking_for) $ greEntryToList $
               lookupGlobalRdrEnv (imv_all_exports imv) occ_name
 
   -- Which of these do that because of an explicit hiding list resp. an
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index 9642617570..94cd516be1 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/compiler/GHC/Rename/Utils.hs
@@ -462,8 +462,7 @@ warnUnusedGRE gre@(GRE { gre_lcl = lcl, gre_imp = is })
 -- names, to be used when reporting unused record fields.
 mkFieldEnv :: GlobalRdrEnv -> NameEnv (FieldLabelString, Parent)
 mkFieldEnv rdr_env = mkNameEnv [ (greMangledName gre, (flLabel fl, gre_par gre))
-                               | gres <- nonDetOccEnvElts rdr_env
-                               , gre <- gres
+                               | gre <- globalRdrEnvElts rdr_env
                                , Just fl <- [greFieldLabel gre]
                                ]
 
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index f474c3383d..40eb2a1f49 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -36,7 +36,8 @@ import {-# SOURCE #-} GHC.Tc.Errors.Hole ( findValidHoleFits )
 
 import GHC.Types.Name
 import GHC.Types.Name.Reader ( lookupGRE_Name, GlobalRdrEnv, mkRdrUnqual
-                             , emptyLocalRdrEnv, lookupGlobalRdrEnv , lookupLocalRdrOcc )
+                             , emptyLocalRdrEnv, lookupGlobalRdrEnv , lookupLocalRdrOcc
+                             , greEntryToList )
 import GHC.Types.Id
 import GHC.Types.Var
 import GHC.Types.Var.Set
@@ -2491,7 +2492,7 @@ mk_dict_err ctxt@(CEC {cec_encl = implics}) (ct, (matches, unifiers, unsafe_over
                           glb_env emptyLocalRdrEnv imp_info (mkRdrUnqual name)) } }
 
     occ_name_in_scope glb_env lcl_env occ_name = not $
-      null (lookupGlobalRdrEnv glb_env occ_name) &&
+      null (greEntryToList (lookupGlobalRdrEnv glb_env occ_name)) &&
       isNothing (lookupLocalRdrOcc lcl_env occ_name)
 
     record_field = case orig of
diff --git a/compiler/GHC/Tc/Gen/Export.hs b/compiler/GHC/Tc/Gen/Export.hs
index acf5a9da3f..394749a79f 100644
--- a/compiler/GHC/Tc/Gen/Export.hs
+++ b/compiler/GHC/Tc/Gen/Export.hs
@@ -386,7 +386,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
           do name <- lookupGlobalOccRn $ ieWrappedName rdr
              let gres = findChildren kids_env name
                  (non_flds, flds) = classifyGREs gres
-             addUsedKids (ieWrappedName rdr) gres
+             addUsedKids (ieWrappedName rdr) (greEntryFromList gres)
              when (null gres) $
                   if isTyConName name
                   then addTcRnDiagnostic (TcRnDodgyExports name)
@@ -405,7 +405,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
     -- In an export item M.T(A,B,C), we want to treat the uses of
     -- A,B,C as if they were M.A, M.B, M.C
     -- Happily pickGREs does just the right thing
-    addUsedKids :: RdrName -> [GlobalRdrElt] -> RnM ()
+    addUsedKids :: RdrName -> GreEntry -> RnM ()
     addUsedKids parent_rdr kid_gres = addUsedGREs (pickGREs parent_rdr kid_gres)
 
 classifyGREs :: [GlobalRdrElt] -> ([Name], [FieldLabel])
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index e8eacc872b..b6dd4dc763 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -1585,7 +1585,7 @@ tcPreludeClashWarn warnFlag name = do
     -- Continue only the name is imported from Prelude
     ; when (importedViaPrelude name rnImports) $ do
       -- Handle 2.-4.
-    { rdrElts <- fmap (concat . nonDetOccEnvElts . tcg_rdr_env) getGblEnv
+    { rdrElts <- fmap (globalRdrEnvElts . tcg_rdr_env) getGblEnv
 
     ; let clashes :: GlobalRdrElt -> Bool
           clashes x = isLocalDef && nameClashes && isNotInProperModule
@@ -1794,7 +1794,7 @@ checkMainType tcg_env
     do { rdr_env <- getGlobalRdrEnv
        ; let dflags    = hsc_dflags hsc_env
              main_occ  = getMainOcc dflags
-             main_gres = lookupGlobalRdrEnv rdr_env main_occ
+             main_gres = greEntryToList (lookupGlobalRdrEnv rdr_env main_occ)
        ; case filter isLocalGRE main_gres of {
             []         -> return emptyWC ;
             (_:_:_)    -> return emptyWC ;
@@ -2041,7 +2041,7 @@ runTcInteractive hsc_env thing_inside
             vcat [ text "ic_tythings:" <+> vcat (map ppr (ic_tythings icxt))
                  , text "ic_insts:" <+> vcat (map (pprBndr LetBind . instanceDFunId) ic_insts)
                  , text "icReaderEnv (LocalDef)" <+>
-                      vcat (map ppr [ local_gres | gres <- nonDetOccEnvElts (icReaderEnv icxt)
+                      vcat (map ppr [ local_gres | gres <- map greEntryToList (nonDetOccEnvElts (icReaderEnv icxt))
                                                  , let local_gres = filter isLocalGRE gres
                                                  , not (null local_gres) ]) ]
 
@@ -2516,7 +2516,7 @@ isGHCiMonad :: HscEnv -> String -> IO (Messages TcRnMessage, Maybe Name)
 isGHCiMonad hsc_env ty
   = runTcInteractive hsc_env $ do
         rdrEnv <- getGlobalRdrEnv
-        let occIO = lookupOccEnv rdrEnv (mkOccName tcName ty)
+        let occIO = greEntryToList <$> lookupOccEnv rdrEnv (mkOccName tcName ty)
         case occIO of
             Just [n] -> do
                 let name = greMangledName n
diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs
index bb0140d5e8..2df1b703c6 100644
--- a/compiler/GHC/Tc/Utils/Backpack.hs
+++ b/compiler/GHC/Tc/Utils/Backpack.hs
@@ -177,7 +177,7 @@ checkHsigIface tcg_env gr sig_iface
       -- The hsig did NOT define this function; that means it must
       -- be a reexport.  In this case, make sure the 'Name' of the
       -- reexport matches the 'Name exported here.
-      | [gre] <- lookupGlobalRdrEnv gr (nameOccName name) = do
+      | [gre] <- greEntryToList (lookupGlobalRdrEnv gr (nameOccName name)) = do
         let name' = greMangledName gre
         when (name /= name') $ do
             -- See Note [Error reporting bad reexport]
@@ -795,7 +795,7 @@ mergeSignatures
     -- STEP 4.1: Merge fixities (we'll verify shortly) tcg_fix_env
     let fix_env = mkNameEnv [ (greMangledName rdr_elt, FixItem occ f)
                             | (occ, f) <- concatMap mi_fixities ifaces
-                            , rdr_elt <- lookupGlobalRdrEnv rdr_env occ ]
+                            , rdr_elt <- greEntryToList (lookupGlobalRdrEnv rdr_env occ) ]
 
     -- STEP 5: Typecheck the interfaces
     let type_env_var = tcg_type_env_var tcg_env
@@ -995,7 +995,7 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do
                     impl_iface False{- safe -} NotBoot ImportedBySystem
         fix_env = mkNameEnv [ (greMangledName rdr_elt, FixItem occ f)
                             | (occ, f) <- mi_fixities impl_iface
-                            , rdr_elt <- lookupGlobalRdrEnv impl_gr occ ]
+                            , rdr_elt <- greEntryToList (lookupGlobalRdrEnv impl_gr occ) ]
     updGblEnv (\tcg_env -> tcg_env {
         -- Setting tcg_rdr_env to treat all exported entities from
         -- the implementing module as in scope improves error messages,
@@ -1036,7 +1036,7 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do
     -- STEP 3: Check that the implementing interface exports everything
     -- we need.  (Notice we IGNORE the Modules in the AvailInfos.)
     forM_ (exportOccs (mi_exports isig_iface)) $ \occ ->
-        case lookupGlobalRdrEnv impl_gr occ of
+        case greEntryToList (lookupGlobalRdrEnv impl_gr occ) of
             [] -> addErr $ TcRnUnknownMessage $ mkPlainError noHints $
                         quotes (ppr occ)
                     <+> text "is exported by the hsig file, but not exported by the implementing module"
diff --git a/compiler/GHC/Types/Name/Ppr.hs b/compiler/GHC/Types/Name/Ppr.hs
index d357d9e5bf..7b8ec345e7 100644
--- a/compiler/GHC/Types/Name/Ppr.hs
+++ b/compiler/GHC/Types/Name/Ppr.hs
@@ -120,7 +120,7 @@ mkPrintUnqualified unit_env env
         right_name gre = greDefinitionModule gre == Just mod
 
         unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env
-        qual_gres   = filter right_name (lookupGlobalRdrEnv env occ)
+        qual_gres   = filter right_name (greEntryToList (lookupGlobalRdrEnv env occ))
 
     -- we can mention a module P:M without the P: qualifier iff
     -- "import M" would resolve unambiguously to P:M.  (if P is the
diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs
index f07df72f9c..e73c976823 100644
--- a/compiler/GHC/Types/Name/Reader.hs
+++ b/compiler/GHC/Types/Name/Reader.hs
@@ -43,7 +43,7 @@ module GHC.Types.Name.Reader (
         elemLocalRdrEnv, inLocalRdrEnvScope,
         localRdrEnvElts, minusLocalRdrEnv,
 
-        -- * Global mapping of 'RdrName' to 'GlobalRdrElt's
+        -- * Global mapping of 'RdrName' to 'GreEntry'
         GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,
         lookupGlobalRdrEnv, extendGlobalRdrEnv, greOccName, shadowNames,
         pprGlobalRdrEnv, globalRdrEnvElts,
@@ -51,7 +51,10 @@ module GHC.Types.Name.Reader (
         lookupGRE_GreName, lookupGRE_FieldLabel,
         lookupGRE_Name_OccName,
         getGRE_NameQualifier_maybes,
-        transformGREs, pickGREs, pickGREsModExp,
+        pickGREs, pickGREsModExp,
+
+        -- * GreEntry
+        GreEntry, singletonGreEntry, greEntryToList, greEntryFromList,
 
         -- * GlobalRdrElts
         gresFromAvails, gresFromAvail, localGREsFromAvail, availFromGRE,
@@ -97,7 +100,7 @@ import GHC.Utils.Panic
 import GHC.Types.Name.Env
 
 import Data.Data
-import Data.List( sortBy )
+import Data.List( sortBy, partition )
 
 {-
 ************************************************************************
@@ -455,7 +458,7 @@ the in-scope-name-set.
 -}
 
 -- | Global Reader Environment
-type GlobalRdrEnv = OccEnv [GlobalRdrElt]
+type GlobalRdrEnv = OccEnv GreEntry
 -- ^ Keyed by 'OccName'; when looking up a qualified name
 -- we look up the 'OccName' part, and then check the 'Provenance'
 -- to see if the appropriate qualification is valid.  This
@@ -481,6 +484,23 @@ type GlobalRdrEnv = OccEnv [GlobalRdrElt]
 --                  nameOccName (greMangledName gre), but not always in the
 --                  case of record selectors; see Note [GreNames]
 
+-- | Global Reader Elements
+--
+-- Morally a [GlobalRdrElt], but pre-sorted so that access to the unqualified
+-- name (a common operation) is fast.
+data GreEntry = GreEntry
+  { gree_unqual :: [GlobalRdrElt]
+      -- ^ INVARIANT: all unQualOK gree_unqual
+  , gree_qual_only :: [GlobalRdrElt]
+      -- ^ INVARIANT: all (not . unQualOK) gree_unqual
+  }
+
+emptyGreEntry :: GreEntry
+emptyGreEntry = GreEntry [] []
+
+greEntryToList :: GreEntry -> [GlobalRdrElt]
+greEntryToList gree = gree_unqual gree ++ gree_qual_only gree
+
 -- | Global Reader Element
 --
 -- An element of the 'GlobalRdrEnv'
@@ -808,7 +828,7 @@ emptyGlobalRdrEnv :: GlobalRdrEnv
 emptyGlobalRdrEnv = emptyOccEnv
 
 globalRdrEnvElts :: GlobalRdrEnv -> [GlobalRdrElt]
-globalRdrEnvElts env = foldOccEnv (++) [] env
+globalRdrEnvElts env = foldOccEnv (\gree -> (greEntryToList gree ++)) [] env
 
 instance Outputable GlobalRdrElt where
   ppr gre = hang (ppr (greMangledName gre) <+> ppr (gre_par gre))
@@ -818,7 +838,8 @@ pprGlobalRdrEnv :: Bool -> GlobalRdrEnv -> SDoc
 pprGlobalRdrEnv locals_only env
   = vcat [ text "GlobalRdrEnv" <+> ppWhen locals_only (text "(locals only)")
              <+> lbrace
-         , nest 2 (vcat [ pp (remove_locals gre_list) | gre_list <- nonDetOccEnvElts env ]
+         , nest 2 (vcat [ pp (remove_locals (greEntryToList gre_list))
+                        | gre_list <- nonDetOccEnvElts env ]
              <+> rbrace) ]
   where
     remove_locals gres | locals_only = filter isLocalGRE gres
@@ -831,10 +852,10 @@ pprGlobalRdrEnv locals_only env
       where
         occ = nameOccName (greMangledName (head gres))
 
-lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt]
+lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> GreEntry
 lookupGlobalRdrEnv env occ_name = case lookupOccEnv env occ_name of
-                                  Nothing   -> []
-                                  Just gres -> gres
+                                  Nothing   -> emptyGreEntry
+                                  Just gree -> gree
 
 lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
 -- ^ Look for this 'RdrName' in the global environment.  Omits record fields
@@ -848,7 +869,7 @@ lookupGRE_RdrName' :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
 lookupGRE_RdrName' rdr_name env
   = case lookupOccEnv env (rdrNameOcc rdr_name) of
     Nothing   -> []
-    Just gres -> pickGREs rdr_name gres
+    Just gree -> pickGREs rdr_name gree
 
 lookupGRE_Name :: GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
 -- ^ Look for precisely this 'Name' in the environment.  This tests
@@ -876,7 +897,7 @@ lookupGRE_Name_OccName :: GlobalRdrEnv -> Name -> OccName -> Maybe GlobalRdrElt
 -- that might differ from that of the 'Name'.  See 'lookupGRE_FieldLabel' and
 -- Note [GreNames].
 lookupGRE_Name_OccName env name occ
-  = case [ gre | gre <- lookupGlobalRdrEnv env occ
+  = case [ gre | gre <- greEntryToList (lookupGlobalRdrEnv env occ)
                , greMangledName gre == name ] of
       []    -> Nothing
       [gre] -> Just gre
@@ -934,8 +955,8 @@ unQualOK (GRE {gre_lcl = lcl, gre_imp = iss })
 
 {- Note [GRE filtering]
 ~~~~~~~~~~~~~~~~~~~~~~~
-(pickGREs rdr gres) takes a list of GREs which have the same OccName
-as 'rdr', say "x".  It does two things:
+(pickGREs rdr gree) takes a GreEntry (i.e. a list of GREs) which have the same
+OccName as 'rdr', say "x".  It does two things:
 
 (a) filters the GREs to a subset that are in scope
     * Qualified,   as 'M.x'  if want_qual    is Qual M _
@@ -965,7 +986,7 @@ Now the "ambiguous occurrence" message can correctly report how the
 ambiguity arises.
 -}
 
-pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
+pickGREs :: RdrName -> GreEntry -> [GlobalRdrElt]
 -- ^ Takes a list of GREs which have the right OccName 'x'
 -- Pick those GREs that are in scope
 --    * Qualified,   as 'M.x'  if want_qual    is Qual M _
@@ -974,8 +995,8 @@ pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
 -- Return each such GRE, with its ImportSpecs filtered, to reflect
 -- how it is in scope qualified or unqualified respectively.
 -- See Note [GRE filtering]
-pickGREs (Unqual {})  gres = mapMaybe pickUnqualGRE     gres
-pickGREs (Qual mod _) gres = mapMaybe (pickQualGRE mod) gres
+pickGREs (Unqual {})  gres = mapMaybe pickUnqualGRE     (gree_unqual gres)
+pickGREs (Qual mod _) gres = mapMaybe (pickQualGRE mod) (greEntryToList gres)
 pickGREs _            _    = []  -- I don't think this actually happens
 
 pickUnqualGRE :: GlobalRdrElt -> Maybe GlobalRdrElt
@@ -1024,23 +1045,55 @@ pickBothGRE mod gre
 -- Building GlobalRdrEnvs
 
 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
-plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2
+plusGlobalRdrEnv env1 env2 = plusOccEnv_C mergeGreEntry env1 env2
 
 mkGlobalRdrEnv :: [GlobalRdrElt] -> GlobalRdrEnv
 mkGlobalRdrEnv gres
   = foldr add emptyGlobalRdrEnv gres
   where
-    add gre env = extendOccEnv_Acc insertGRE Utils.singleton env
+    add gre env = extendOccEnv_Acc insertGRE singletonGreEntry env
                                    (greOccName gre)
                                    gre
 
-insertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
-insertGRE new_g [] = [new_g]
-insertGRE new_g (old_g : old_gs)
-        | gre_name new_g == gre_name old_g
-        = new_g `plusGRE` old_g : old_gs
+singletonGreEntry :: GlobalRdrElt -> GreEntry
+singletonGreEntry g
+  | unQualOK g = GreEntry { gree_unqual = [g], gree_qual_only = [] }
+  | otherwise  = GreEntry { gree_unqual = [], gree_qual_only = [g] }
+
+mergeGreEntry :: GreEntry -> GreEntry -> GreEntry
+mergeGreEntry gree1 gree2 = foldl' (flip insertGRE) gree1 (greEntryToList gree2)
+
+greEntryFromList :: [GlobalRdrElt] -> GreEntry
+greEntryFromList gres = foldl' (flip insertGRE) emptyGreEntry gres
+
+-- | To insert a GlobalRdrElt in a GreEntry, we need to
+--
+-- * find an existing GreEntry for that name, if present
+-- * merge them
+-- * and put them in the right section (gree_unqual or gree_qual_only)
+insertGRE :: GlobalRdrElt -> GreEntry -> GreEntry
+insertGRE new_g gree0 = gree2
+  where
+
+    (merged_g, gree1)
+        | Just (old_g, gree_unqual') <- find_and_remove (gree_unqual gree0)
+        = (new_g `plusGRE` old_g, gree0 { gree_unqual = gree_unqual' })
+        | Just (old_g, gree_qual_only') <- find_and_remove (gree_qual_only gree0)
+        = (new_g `plusGRE` old_g, gree0 { gree_qual_only = gree_qual_only' })
         | otherwise
-        = old_g : insertGRE new_g old_gs
+        = (new_g, gree0)
+
+    -- here we establish the invariant on GreEntry
+    gree2 | unQualOK merged_g = gree1 { gree_unqual = merged_g : gree_unqual gree1 }
+          | otherwise         = gree1 { gree_qual_only = merged_g : gree_qual_only gree1 }
+
+
+    find_and_remove :: [GlobalRdrElt] -> Maybe (GlobalRdrElt, [GlobalRdrElt])
+    find_and_remove gres =
+        case partition (\old_g -> gre_name old_g == gre_name new_g) gres of
+            ([], _) -> Nothing
+            ([old_g], gres') -> Just (old_g, gres')
+            _ -> pprPanic "insertGRE" (ppr gres) -- INVARIANT 1
 
 plusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt
 -- Used when the gre_name fields match
@@ -1050,21 +1103,9 @@ plusGRE g1 g2
         , gre_imp  = gre_imp g1 ++ gre_imp g2
         , gre_par  = gre_par  g1 `plusParent` gre_par  g2 }
 
-transformGREs :: (GlobalRdrElt -> GlobalRdrElt)
-              -> [OccName]
-              -> GlobalRdrEnv -> GlobalRdrEnv
--- ^ Apply a transformation function to the GREs for these OccNames
-transformGREs trans_gre occs rdr_env
-  = foldr trans rdr_env occs
-  where
-    trans occ env
-      = case lookupOccEnv env occ of
-           Just gres -> extendOccEnv env occ (map trans_gre gres)
-           Nothing   -> env
-
 extendGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv
 extendGlobalRdrEnv env gre
-  = extendOccEnv_Acc insertGRE Utils.singleton env
+  = extendOccEnv_Acc insertGRE singletonGreEntry env
                      (greOccName gre) gre
 
 {- Note [GlobalRdrEnv shadowing]
@@ -1145,22 +1186,23 @@ There are two reasons for shadowing:
 shadowNames :: GlobalRdrEnv -> OccEnv a -> GlobalRdrEnv
 -- Remove certain old GREs that share the same OccName as this new Name.
 -- See Note [GlobalRdrEnv shadowing] for details
-shadowNames = minusOccEnv_C (\gres _ -> Just (mapMaybe shadow gres))
+shadowNames = minusOccEnv_C (\gres _ -> Just (shadowGreEntry gres))
   where
-    shadow :: GlobalRdrElt -> Maybe GlobalRdrElt
-    shadow
-       old_gre@(GRE { gre_lcl = lcl, gre_imp = iss })
+    -- The resulting GreEntry has _no_ unqualified names
+    shadowGreEntry :: GreEntry -> GreEntry
+    shadowGreEntry gree@GreEntry{ gree_unqual = unqual, gree_qual_only = qual_only}
+        | null unqual = gree
+        | otherwise = GreEntry { gree_unqual = []
+                               , gree_qual_only = map shadowGRE unqual ++ qual_only }
+
+    -- The resulting GreEntry has unQualOK == True
+    shadowGRE :: GlobalRdrElt -> GlobalRdrElt
+    shadowGRE old_gre@(GRE { gre_lcl = lcl, gre_imp = iss })
        = case greDefinitionModule old_gre of
-           Nothing -> Just old_gre   -- Old name is Internal; do not shadow
-           Just old_mod
-              | null iss'            -- Nothing remains
-              -> Nothing
-
-              | otherwise
-              -> Just (old_gre { gre_lcl = False, gre_imp = iss' })
-
+           Nothing -> old_gre   -- Old name is Internal; do not shadow
+           Just old_mod -> old_gre { gre_lcl = False, gre_imp = iss' }
               where
-                iss' = lcl_imp ++ mapMaybe set_qual iss
+                iss' = lcl_imp ++ map set_qual iss
                 lcl_imp | lcl       = [mk_fake_imp_spec old_gre old_mod]
                         | otherwise = []
 
@@ -1173,8 +1215,8 @@ shadowNames = minusOccEnv_C (\gres _ -> Just (mapMaybe shadow gres))
                                    , is_qual = True
                                    , is_dloc = greDefinitionSrcSpan old_gre }
 
-    set_qual :: ImportSpec -> Maybe ImportSpec
-    set_qual is = Just (is { is_decl = (is_decl is) { is_qual = True } })
+    set_qual :: ImportSpec -> ImportSpec
+    set_qual is = is { is_decl = (is_decl is) { is_qual = True } }
 
 
 {-