summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
eda42a0)
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
OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv, mapOccEnv,
lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv,
occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
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,
-- * The 'OccSet' type
OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet,
foldOccEnv :: (a -> b -> b) -> b -> OccEnv a -> b
occEnvElts :: OccEnv a -> [a]
extendOccEnv_C :: (a->a->a) -> OccEnv a -> OccName -> a -> OccEnv a
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
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
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
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
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
Just gres -> gres
extendGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv
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)
where
occ = nameOccName (gre_name gre)
lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName rdr_name env
lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName rdr_name env
mkGlobalRdrEnv gres
= foldr add emptyGlobalRdrEnv gres
where
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
findLocalDupsRdrEnv :: GlobalRdrEnv -> [OccName] -> (GlobalRdrEnv, [[Name]])
-- ^ For each 'OccName', see if there are multiple local definitions
-- ** Manipulating these environments
emptyVarEnv, unitVarEnv, mkVarEnv,
elemVarEnv, varEnvElts, varEnvKeys,
-- ** 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,
plusVarEnv, plusVarEnv_C,
delVarEnvList, delVarEnv,
lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
unitVarEnv :: Var -> a -> VarEnv a
extendVarEnv :: VarEnv a -> Var -> a -> VarEnv a
extendVarEnv_C :: (a->a->a) -> VarEnv a -> 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
plusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a
extendVarEnvList :: VarEnv a -> [(Var, a)] -> VarEnv a
elemVarEnvByKey = elemUFM_Directly
extendVarEnv = addToUFM
extendVarEnv_C = addToUFM_C
elemVarEnvByKey = elemUFM_Directly
extendVarEnv = addToUFM
extendVarEnv_C = addToUFM_C
+extendVarEnv_Acc = addToUFM_Acc
extendVarEnvList = addListToUFM
plusVarEnv_C = plusUFM_C
delVarEnvList = delListFromUFM
extendVarEnvList = addListToUFM
plusVarEnv_C = plusUFM_C
delVarEnvList = delListFromUFM
mkChildEnv :: [GlobalRdrElt] -> NameEnv [Name]
mkChildEnv gres = foldr add emptyNameEnv gres
where
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]
add _ env = env
findChildren :: NameEnv [Name] -> Name -> [Name]
| otherwise = PE env2 fvs2 -- don't extend
where
PE env1 fvs1 = trimProxyEnv pe [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
fvs2 = fvs1 `unionVarSet` freeVarsCoI co
`extendVarSet` case_bndr
`extendVarSet` scrut1