Commit 65277a1c authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Use addToUFM_Acc where appropriate

This way of extending a UniqFM has existed for some time, but
we weren't really using it.

addToUFM_Acc	:: Uniquable key =>
			      (elt -> elts -> elts)	-- Add to existing
			   -> (elt -> elts)		-- New element
			   -> UniqFM elts 		-- old
			   -> key -> elt 		-- new
			   -> UniqFM elts		-- result
parent eda42a0e
......@@ -75,7 +75,7 @@ module OccName (
OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv, mapOccEnv,
lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv,
occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
filterOccEnv, delListFromOccEnv, delFromOccEnv,
extendOccEnv_Acc, filterOccEnv, delListFromOccEnv, delFromOccEnv,
-- * The 'OccSet' type
OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet,
......@@ -335,6 +335,7 @@ elemOccEnv :: OccName -> OccEnv a -> Bool
foldOccEnv :: (a -> b -> b) -> b -> OccEnv a -> b
occEnvElts :: OccEnv a -> [a]
extendOccEnv_C :: (a->a->a) -> OccEnv a -> OccName -> a -> OccEnv a
extendOccEnv_Acc :: (a->b->b) -> (a->b) -> OccEnv b -> OccName -> a -> OccEnv b
plusOccEnv :: OccEnv a -> OccEnv a -> OccEnv a
plusOccEnv_C :: (a->a->a) -> OccEnv a -> OccEnv a -> OccEnv a
mapOccEnv :: (a->b) -> OccEnv a -> OccEnv b
......@@ -354,6 +355,7 @@ occEnvElts (A x) = eltsUFM x
plusOccEnv (A x) (A y) = A $ plusUFM x y
plusOccEnv_C f (A x) (A y) = A $ plusUFM_C f x y
extendOccEnv_C f (A x) y z = A $ addToUFM_C f x y z
extendOccEnv_Acc f g (A x) y z = A $ addToUFM_Acc f g x y z
mapOccEnv f (A x) = A $ mapUFM f x
mkOccEnv_C comb l = A $ addListToUFM_C comb emptyUFM l
delFromOccEnv (A x) y = A $ delFromUFM x y
......
......@@ -428,10 +428,9 @@ lookupGlobalRdrEnv env occ_name = case lookupOccEnv env occ_name of
Just gres -> gres
extendGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv
extendGlobalRdrEnv env gre = extendOccEnv_C add env occ [gre]
extendGlobalRdrEnv env gre = extendOccEnv_Acc (:) singleton env occ gre
where
occ = nameOccName (gre_name gre)
add gres _ = gre:gres
lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName rdr_name env
......@@ -515,9 +514,9 @@ mkGlobalRdrEnv :: [GlobalRdrElt] -> GlobalRdrEnv
mkGlobalRdrEnv gres
= foldr add emptyGlobalRdrEnv gres
where
add gre env = extendOccEnv_C (foldr insertGRE) env
(nameOccName (gre_name gre))
[gre]
add gre env = extendOccEnv_Acc insertGRE singleton env
(nameOccName (gre_name gre))
gre
findLocalDupsRdrEnv :: GlobalRdrEnv -> [OccName] -> (GlobalRdrEnv, [[Name]])
-- ^ For each 'OccName', see if there are multiple local definitions
......
......@@ -11,7 +11,7 @@ module VarEnv (
-- ** Manipulating these environments
emptyVarEnv, unitVarEnv, mkVarEnv,
elemVarEnv, varEnvElts, varEnvKeys,
extendVarEnv, extendVarEnv_C, extendVarEnvList,
extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnvList,
plusVarEnv, plusVarEnv_C,
delVarEnvList, delVarEnv,
lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
......@@ -316,6 +316,7 @@ zipVarEnv :: [Var] -> [a] -> VarEnv a
unitVarEnv :: Var -> a -> VarEnv a
extendVarEnv :: VarEnv a -> Var -> a -> VarEnv a
extendVarEnv_C :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a
extendVarEnv_Acc :: (a->b->b) -> (a->b) -> VarEnv b -> Var -> a -> VarEnv b
plusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a
extendVarEnvList :: VarEnv a -> [(Var, a)] -> VarEnv a
......@@ -344,6 +345,7 @@ elemVarEnv = elemUFM
elemVarEnvByKey = elemUFM_Directly
extendVarEnv = addToUFM
extendVarEnv_C = addToUFM_C
extendVarEnv_Acc = addToUFM_Acc
extendVarEnvList = addListToUFM
plusVarEnv_C = plusUFM_C
delVarEnvList = delListFromUFM
......
......@@ -722,7 +722,7 @@ gresFromIE decl_spec (L loc ie, avail)
mkChildEnv :: [GlobalRdrElt] -> NameEnv [Name]
mkChildEnv gres = foldr add emptyNameEnv gres
where
add (GRE { gre_name = n, gre_par = ParentIs p }) env = extendNameEnv_C (++) env p [n]
add (GRE { gre_name = n, gre_par = ParentIs p }) env = extendNameEnv_Acc (:) singleton env p n
add _ env = env
findChildren :: NameEnv [Name] -> Name -> [Name]
......
......@@ -1370,8 +1370,9 @@ extendProxyEnv pe scrut co case_bndr
| otherwise = PE env2 fvs2 -- don't extend
where
PE env1 fvs1 = trimProxyEnv pe [case_bndr]
env2 = extendVarEnv_C add env1 scrut1 (scrut1, [(case_bndr,co)])
add (x, cb_cos) _ = (x, (case_bndr,co):cb_cos)
env2 = extendVarEnv_Acc add single env1 scrut1 (case_bndr,co)
single cb_co = (scrut1, [cb_co])
add cb_co (x, cb_cos) = (x, cb_co:cb_cos)
fvs2 = fvs1 `unionVarSet` freeVarsCoI co
`extendVarSet` case_bndr
`extendVarSet` scrut1
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment