summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoachim Breitner <mail@joachim-breitner.de>2021-10-12 21:29:50 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-10-15 18:17:26 -0400
commitb6954f0ca8b6a4408f202405e30fea6328a68d92 (patch)
treec07ffd5784d0a809234bb3956b402aa78f37bcd3
parentbbb1f6dab34243af0a2841164e33eec451396b3f (diff)
downloadhaskell-b6954f0ca8b6a4408f202405e30fea6328a68d92.tar.gz
shadowNames: Use OccEnv a, not [OccName]
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.
-rw-r--r--compiler/GHC/Rename/Names.hs4
-rw-r--r--compiler/GHC/Runtime/Context.hs3
-rw-r--r--compiler/GHC/Types/Name/Occurrence.hs13
-rw-r--r--compiler/GHC/Types/Name/Reader.hs23
-rw-r--r--compiler/GHC/Types/Unique/FM.hs9
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)