shadowNames: Use OccEnv a, not [OccName]wip/joachim/shadowName-OccSet

this allows us to use a smarter implementation based on
`Data.IntSet.differenceWith`, which should do less work. Also, it will
unblock improvements to !6703.

The `OccEnv a` really denotes a set of `OccName`s. We are not using
`OccSet`, though, because that is an `OccEnv OccName`, and we in !6703
we want to use this with differently-valued `OccEnv`s. But `OccSet`s are
readily and safely coerced into `OccEnv`s.

There is no other use of `delLocalRdrEnvList` remaining, so removing
that.

5 files changed, 34 insertions, 18 deletions

diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index 9cba5f5997..7392b76c64 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -652,7 +652,7 @@ extendGlobalRdrEnvRn avails new_fixities
               -- See Note [GlobalRdrEnv shadowing]
               inBracket = isBrackStage stage
 
-              lcl_env_TH = lcl_env { tcl_rdr = delLocalRdrEnvList (tcl_rdr lcl_env) new_occs }
+              lcl_env_TH = lcl_env { tcl_rdr = minusLocalRdrEnv (tcl_rdr lcl_env) new_occs }
                            -- See Note [GlobalRdrEnv shadowing]
 
               lcl_env2 | inBracket = lcl_env_TH
@@ -677,7 +677,7 @@ extendGlobalRdrEnvRn avails new_fixities
         ; return (gbl_env', lcl_env3) }
   where
     new_names = concatMap availGreNames avails
-    new_occs  = map occName new_names
+    new_occs  = occSetToEnv (mkOccSet (map occName new_names))
 
     -- If there is a fixity decl for the gre, add it to the fixity env
     extend_fix_env fix_env gre
diff --git a/compiler/GHC/Runtime/Context.hs b/compiler/GHC/Runtime/Context.hs
index aaf99ee9a7..b364c0d184 100644
--- a/compiler/GHC/Runtime/Context.hs
+++ b/compiler/GHC/Runtime/Context.hs
@@ -368,7 +368,8 @@ icExtendGblRdrEnv env tythings
        = foldl' extendGlobalRdrEnv env1 (concatMap localGREsFromAvail avail)
        where
           new_gres = concatMap availGreNames avail
-          env1  = shadowNames env (map occName new_gres)
+          new_occs = occSetToEnv (mkOccSet (map occName new_gres))
+          env1  = shadowNames env new_occs
           avail = tyThingAvailInfo thing
 
     -- Ugh! The new_tythings may include record selectors, since they
diff --git a/compiler/GHC/Types/Name/Occurrence.hs b/compiler/GHC/Types/Name/Occurrence.hs
index 3f886fc549..cb98413279 100644
--- a/compiler/GHC/Types/Name/Occurrence.hs
+++ b/compiler/GHC/Types/Name/Occurrence.hs
@@ -83,14 +83,14 @@ module GHC.Types.Name.Occurrence (
         lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv,
         nonDetOccEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
         extendOccEnv_Acc, filterOccEnv, delListFromOccEnv, delFromOccEnv,
-        alterOccEnv, pprOccEnv,
+        alterOccEnv, minusOccEnv, minusOccEnv_C, pprOccEnv,
 
         -- * The 'OccSet' type
         OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet,
         extendOccSetList,
         unionOccSets, unionManyOccSets, minusOccSet, elemOccSet,
         isEmptyOccSet, intersectOccSet,
-        filterOccSet,
+        filterOccSet, occSetToEnv,
 
         -- * Tidying up
         TidyOccEnv, emptyTidyOccEnv, initTidyOccEnv,
@@ -411,6 +411,10 @@ delFromOccEnv      :: OccEnv a -> OccName -> OccEnv a
 delListFromOccEnv :: OccEnv a -> [OccName] -> OccEnv a
 filterOccEnv       :: (elt -> Bool) -> OccEnv elt -> OccEnv elt
 alterOccEnv        :: (Maybe elt -> Maybe elt) -> OccEnv elt -> OccName -> OccEnv elt
+minusOccEnv :: OccEnv a -> OccEnv b -> OccEnv a
+
+-- | Alters (replaces or removes) those elements of the map that are mentioned in the second map
+minusOccEnv_C :: (a -> b -> Maybe a) -> OccEnv a -> OccEnv b -> OccEnv a
 
 emptyOccEnv      = A emptyUFM
 unitOccEnv x y = A $ unitUFM x y
@@ -431,6 +435,8 @@ delFromOccEnv (A x) y    = A $ delFromUFM x y
 delListFromOccEnv (A x) y  = A $ delListFromUFM x y
 filterOccEnv x (A y)       = A $ filterUFM x y
 alterOccEnv fn (A y) k     = A $ alterUFM fn y k
+minusOccEnv (A x) (A y) = A $ minusUFM x y
+minusOccEnv_C fn (A x) (A y) = A $ minusUFM_C fn x y
 
 instance Outputable a => Outputable (OccEnv a) where
     ppr x = pprOccEnv ppr x
@@ -452,6 +458,8 @@ elemOccSet        :: OccName -> OccSet -> Bool
 isEmptyOccSet     :: OccSet -> Bool
 intersectOccSet   :: OccSet -> OccSet -> OccSet
 filterOccSet      :: (OccName -> Bool) -> OccSet -> OccSet
+-- | Converts an OccSet to an OccEnv (operationally the identity)
+occSetToEnv       :: OccSet -> OccEnv OccName
 
 emptyOccSet       = emptyUniqSet
 unitOccSet        = unitUniqSet
@@ -465,6 +473,7 @@ elemOccSet        = elementOfUniqSet
 isEmptyOccSet     = isEmptyUniqSet
 intersectOccSet   = intersectUniqSets
 filterOccSet      = filterUniqSet
+occSetToEnv       = A . getUniqSet
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs
index 426849ff2f..f07df72f9c 100644
--- a/compiler/GHC/Types/Name/Reader.hs
+++ b/compiler/GHC/Types/Name/Reader.hs
@@ -41,7 +41,7 @@ module GHC.Types.Name.Reader (
         LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, extendLocalRdrEnvList,
         lookupLocalRdrEnv, lookupLocalRdrOcc,
         elemLocalRdrEnv, inLocalRdrEnvScope,
-        localRdrEnvElts, delLocalRdrEnvList,
+        localRdrEnvElts, minusLocalRdrEnv,
 
         -- * Global mapping of 'RdrName' to 'GlobalRdrElt's
         GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,
@@ -434,9 +434,9 @@ inLocalRdrEnvScope :: Name -> LocalRdrEnv -> Bool
 -- This is the point of the NameSet
 inLocalRdrEnvScope name (LRE { lre_in_scope = ns }) = name `elemNameSet` ns
 
-delLocalRdrEnvList :: LocalRdrEnv -> [OccName] -> LocalRdrEnv
-delLocalRdrEnvList lre@(LRE { lre_env = env }) occs
-  = lre { lre_env = delListFromOccEnv env occs }
+minusLocalRdrEnv :: LocalRdrEnv -> OccEnv a -> LocalRdrEnv
+minusLocalRdrEnv lre@(LRE { lre_env = env }) occs
+  = lre { lre_env = minusOccEnv env occs }
 
 {-
 Note [Local bindings with Exact Names]
@@ -1067,15 +1067,12 @@ extendGlobalRdrEnv env gre
   = extendOccEnv_Acc insertGRE Utils.singleton env
                      (greOccName gre) gre
 
-shadowNames :: GlobalRdrEnv -> [OccName] -> GlobalRdrEnv
-shadowNames = foldl' shadowName
-
 {- Note [GlobalRdrEnv shadowing]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Before adding new names to the GlobalRdrEnv we nuke some existing entries;
-this is "shadowing".  The actual work is done by RdrEnv.shadowName.
+this is "shadowing".  The actual work is done by RdrEnv.shadowNames.
 Suppose
-   env' = shadowName env f `extendGlobalRdrEnv` M.f
+   env' = shadowNames env f `extendGlobalRdrEnv` M.f
 
 Then:
    * Looking up (Unqual f) in env' should succeed, returning M.f,
@@ -1087,7 +1084,7 @@ Then:
    * Looking up (Qual X.f) in env', where X /= M, should be the same as
      looking up (Qual X.f) in env.
 
-     That is, shadowName does /not/ delete earlier qualified bindings
+     That is, shadowNames does /not/ delete earlier qualified bindings
 
 There are two reasons for shadowing:
 
@@ -1111,7 +1108,7 @@ There are two reasons for shadowing:
 
     So when we add `x = True` we must not delete the `M.x` from the
     `GlobalRdrEnv`; rather we just want to make it "qualified only";
-    hence the `set_qual` in `shadowName`.  See also Note
+    hence the `set_qual` in `shadowNames`.  See also Note
     [Interactively-bound Ids in GHCi] in GHC.Runtime.Context
 
   - Data types also have External Names, like Ghci4.T; but we still want
@@ -1145,10 +1142,10 @@ There are two reasons for shadowing:
       At that stage, the class op 'f' will have an Internal name.
 -}
 
-shadowName :: GlobalRdrEnv -> OccName -> GlobalRdrEnv
+shadowNames :: GlobalRdrEnv -> OccEnv a -> GlobalRdrEnv
 -- Remove certain old GREs that share the same OccName as this new Name.
 -- See Note [GlobalRdrEnv shadowing] for details
-shadowName = alterOccEnv (fmap (mapMaybe shadow))
+shadowNames = minusOccEnv_C (\gres _ -> Just (mapMaybe shadow gres))
   where
     shadow :: GlobalRdrElt -> Maybe GlobalRdrElt
     shadow
diff --git a/compiler/GHC/Types/Unique/FM.hs b/compiler/GHC/Types/Unique/FM.hs
index 1be4628d8e..265345e2ec 100644
--- a/compiler/GHC/Types/Unique/FM.hs
+++ b/compiler/GHC/Types/Unique/FM.hs
@@ -59,6 +59,7 @@ module GHC.Types.Unique.FM (
         plusUFMList,
         sequenceUFMList,
         minusUFM,
+        minusUFM_C,
         intersectUFM,
         intersectUFM_C,
         disjointUFM,
@@ -315,6 +316,14 @@ sequenceUFMList = foldr (plusUFM_CD2 cons) emptyUFM
 minusUFM :: UniqFM key elt1 -> UniqFM key elt2 -> UniqFM key elt1
 minusUFM (UFM x) (UFM y) = UFM (M.difference x y)
 
+-- | @minusUFC_C f map1 map2@ returns @map1@, except that every mapping @key
+-- |-> value1@ in @map1@ that shares a key with a mapping @key |-> value2@ in
+-- @map2@ is altered by @f@: @value1@ is replaced by @f value1 value2@, where
+-- 'Just' means that the new value is used and 'Nothing' means that the mapping
+-- is deleted.
+minusUFM_C :: (elt1 -> elt2 -> Maybe elt1) -> UniqFM key elt1 -> UniqFM key elt2 -> UniqFM key elt1
+minusUFM_C f (UFM x) (UFM y) = UFM (M.differenceWith f x y)
+
 intersectUFM :: UniqFM key elt1 -> UniqFM key elt2 -> UniqFM key elt1
 intersectUFM (UFM x) (UFM y) = UFM (M.intersection x y)