Commit c05c0659 authored by Simon Jakobi's avatar Simon Jakobi Committed by Marge Bot

Improve some folds over Uniq[D]FM

* Replace some non-deterministic lazy folds with
  strict folds.
* Replace some O(n log n) folds in deterministic order
  with O(n) non-deterministic folds.
* Replace some folds with set-operations on the underlying
  IntMaps.

This reduces max residency when compiling
`nofib/spectral/simple/Main.hs` with -O0 by about 1%.

Maximum residency when compiling Cabal also seems reduced on the
order of 3-9%.
parent c9f5a8f4
......@@ -554,8 +554,9 @@ delAssoc :: (Uniquable a)
delAssoc a m
| Just aSet <- lookupUFM m a
, m1 <- delFromUFM m a
= nonDetFoldUniqSet (\x m -> delAssoc1 x a m) m1 aSet
-- It's OK to use nonDetFoldUFM here because deletion is commutative
= nonDetStrictFoldUniqSet (\x m -> delAssoc1 x a m) m1 aSet
-- It's OK to use a non-deterministic fold here because deletion is
-- commutative
| otherwise = m
......
......@@ -380,8 +380,8 @@ famInstEnvElts fi = [elt | FamIE elts <- eltsUDFM fi, elt <- elts]
-- See Note [FamInstEnv determinism]
famInstEnvSize :: FamInstEnv -> Int
famInstEnvSize = nonDetFoldUDFM (\(FamIE elt) sum -> sum + length elt) 0
-- It's OK to use nonDetFoldUDFM here since we're just computing the
famInstEnvSize = nonDetStrictFoldUDFM (\(FamIE elt) sum -> sum + length elt) 0
-- It's OK to use nonDetStrictFoldUDFM here since we're just computing the
-- size.
familyInstances :: (FamInstEnv, FamInstEnv) -> TyCon -> [FamInst]
......
......@@ -2245,8 +2245,8 @@ extendFvs env s
= (s `unionVarSet` extras, extras `subVarSet` s)
where
extras :: VarSet -- env(s)
extras = nonDetFoldUFM unionVarSet emptyVarSet $
-- It's OK to use nonDetFoldUFM here because unionVarSet commutes
extras = nonDetStrictFoldUFM unionVarSet emptyVarSet $
-- It's OK to use nonDetStrictFoldUFM here because unionVarSet commutes
intersectUFM_C (\x _ -> x) env (getUniqSet s)
{-
......@@ -2567,8 +2567,8 @@ addManyOcc v u | isId v = addManyOccId u v
-- (Same goes for INLINE.)
addManyOccs :: UsageDetails -> VarSet -> UsageDetails
addManyOccs usage id_set = nonDetFoldUniqSet addManyOcc usage id_set
-- It's OK to use nonDetFoldUFM here because addManyOcc commutes
addManyOccs usage id_set = nonDetStrictFoldUniqSet addManyOcc usage id_set
-- It's OK to use nonDetStrictFoldUniqSet here because addManyOcc commutes
delDetails :: UsageDetails -> Id -> UsageDetails
delDetails ud bndr
......
......@@ -83,7 +83,7 @@ import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.Var
import GHC.Types.Var.Set
import GHC.Types.Unique.Set ( nonDetFoldUniqSet )
import GHC.Types.Unique.Set ( nonDetStrictFoldUniqSet )
import GHC.Types.Unique.DSet ( getUniqDSet )
import GHC.Types.Var.Env
import GHC.Types.Literal ( litIsTrivial )
......@@ -1469,8 +1469,8 @@ isFunction (_, AnnLam b e) | isId b = True
isFunction _ = False
countFreeIds :: DVarSet -> Int
countFreeIds = nonDetFoldUDFM add 0 . getUniqDSet
-- It's OK to use nonDetFoldUDFM here because we're just counting things.
countFreeIds = nonDetStrictFoldUDFM add 0 . getUniqDSet
-- It's OK to use nonDetStrictFoldUDFM here because we're just counting things.
where
add :: Var -> Int -> Int
add v n | isId v = n+1
......@@ -1581,12 +1581,14 @@ placeJoinCeiling le@(LE { le_ctxt_lvl = lvl })
maxFvLevel :: (Var -> Bool) -> LevelEnv -> DVarSet -> Level
maxFvLevel max_me env var_set
= foldDVarSet (maxIn max_me env) tOP_LEVEL var_set
= nonDetStrictFoldDVarSet (maxIn max_me env) tOP_LEVEL var_set
-- It's OK to use a non-deterministic fold here because maxIn commutes.
maxFvLevel' :: (Var -> Bool) -> LevelEnv -> TyCoVarSet -> Level
-- Same but for TyCoVarSet
maxFvLevel' max_me env var_set
= nonDetFoldUniqSet (maxIn max_me env) tOP_LEVEL var_set
= nonDetStrictFoldUniqSet (maxIn max_me env) tOP_LEVEL var_set
-- It's OK to use a non-deterministic fold here because maxIn commutes.
maxIn :: (Var -> Bool) -> LevelEnv -> InVar -> Level -> Level
maxIn max_me (LE { le_lvl_env = lvl_env, le_env = id_env }) in_var lvl
......
......@@ -2431,8 +2431,8 @@ unionCallInfoSet (CIS f calls1) (CIS _ calls2) =
callDetailsFVs :: CallDetails -> VarSet
callDetailsFVs calls =
nonDetFoldUDFM (unionVarSet . callInfoFVs) emptyVarSet calls
-- It's OK to use nonDetFoldUDFM here because we forget the ordering
nonDetStrictFoldUDFM (unionVarSet . callInfoFVs) emptyVarSet calls
-- It's OK to use nonDetStrictFoldUDFM here because we forget the ordering
-- immediately by converting to a nondeterministic set.
callInfoFVs :: CallInfoSet -> VarSet
......
......@@ -441,7 +441,7 @@ deepCoVarFolder = TyCoFolder { tcf_view = noView
closeOverKinds :: TyCoVarSet -> TyCoVarSet
-- For each element of the input set,
-- add the deep free variables of its kind
closeOverKinds vs = nonDetFoldVarSet do_one vs vs
closeOverKinds vs = nonDetStrictFoldVarSet do_one vs vs
where
do_one v acc = appEndo (deep_ty (varType v)) acc
......
......@@ -658,9 +658,9 @@ niSubstTvSet :: TvSubstEnv -> TyCoVarSet -> TyCoVarSet
-- remembering that the substitution isn't necessarily idempotent
-- This is used in the occurs check, before extending the substitution
niSubstTvSet tsubst tvs
= nonDetFoldUniqSet (unionVarSet . get) emptyVarSet tvs
-- It's OK to nonDetFoldUFM here because we immediately forget the
-- ordering by creating a set.
= nonDetStrictFoldUniqSet (unionVarSet . get) emptyVarSet tvs
-- It's OK to use a non-deterministic fold here because we immediately forget
-- the ordering by creating a set.
where
get tv
| Just ty <- lookupVarEnv tsubst tv
......
......@@ -79,8 +79,8 @@ addNode k node graph
= let
-- add back conflict edges from other nodes to this one
map_conflict =
nonDetFoldUniqSet
-- It's OK to use nonDetFoldUFM here because the
nonDetStrictFoldUniqSet
-- It's OK to use a non-deterministic fold here because the
-- operation is commutative
(adjustUFM_C (\n -> n { nodeConflicts =
addOneToUniqSet (nodeConflicts n) k}))
......@@ -89,8 +89,8 @@ addNode k node graph
-- add back coalesce edges from other nodes to this one
map_coalesce =
nonDetFoldUniqSet
-- It's OK to use nonDetFoldUFM here because the
nonDetStrictFoldUniqSet
-- It's OK to use a non-deterministic fold here because the
-- operation is commutative
(adjustUFM_C (\n -> n { nodeCoalesce =
addOneToUniqSet (nodeCoalesce n) k}))
......@@ -492,9 +492,9 @@ freezeNode k
else node -- panic "GHC.Data.Graph.Ops.freezeNode: edge to freeze wasn't in the coalesce set"
-- If the edge isn't actually in the coelesce set then just ignore it.
fm2 = nonDetFoldUniqSet (adjustUFM_C (freezeEdge k)) fm1
-- It's OK to use nonDetFoldUFM here because the operation
-- is commutative
fm2 = nonDetStrictFoldUniqSet (adjustUFM_C (freezeEdge k)) fm1
-- It's OK to use a non-deterministic fold here because the
-- operation is commutative
$ nodeCoalesce node
in fm2
......
......@@ -261,9 +261,9 @@ mk_mod_usage_info pit hsc_env this_mod direct_imports used_names
-- ent_map groups together all the things imported and used
-- from a particular module
ent_map :: ModuleEnv [OccName]
ent_map = nonDetFoldUniqSet add_mv emptyModuleEnv used_names
-- nonDetFoldUFM is OK here. If you follow the logic, we sort by OccName
-- in ent_hashs
ent_map = nonDetStrictFoldUniqSet add_mv emptyModuleEnv used_names
-- nonDetStrictFoldUniqSet is OK here. If you follow the logic, we sort by
-- OccName in ent_hashs
where
add_mv name mv_map
| isWiredInName name = mv_map -- ignore wired-in names
......
......@@ -1400,8 +1400,8 @@ depAnalTyClDecls rdr_env kisig_fv_env ds_w_fvs
toParents :: GlobalRdrEnv -> NameSet -> NameSet
toParents rdr_env ns
= nonDetFoldUniqSet add emptyNameSet ns
-- It's OK to use nonDetFoldUFM because we immediately forget the
= nonDetStrictFoldUniqSet add emptyNameSet ns
-- It's OK to use a non-deterministic fold because we immediately forget the
-- ordering by creating a set
where
add n s = extendNameSet s (getParent rdr_env n)
......
......@@ -545,7 +545,8 @@ closureGrowth expander sizer group abs_ids = go
-- we lift @f@
newbies = abs_ids `minusDVarSet` clo_fvs'
-- Lifting @f@ removes @f@ from the closure but adds all @newbies@
cost = foldDVarSet (\id size -> sizer id + size) 0 newbies - n_occs
cost = nonDetStrictFoldDVarSet (\id size -> sizer id + size) 0 newbies - n_occs
-- Using a non-deterministic fold is OK here because addition is commutative.
go (RhsSk body_dmd body)
-- The conservative assumption would be that
-- 1. Every RHS with positive growth would be called multiple times,
......
......@@ -1851,11 +1851,13 @@ neededEvVars implic@(Implic { ic_given = givens
; tcvs <- TcS.getTcEvTyCoVars ev_binds_var
; let seeds1 = foldr add_implic_seeds old_needs implics
seeds2 = foldEvBindMap add_wanted seeds1 ev_binds
seeds2 = nonDetStrictFoldEvBindMap add_wanted seeds1 ev_binds
-- It's OK to use a non-deterministic fold here
-- because add_wanted is commutative
seeds3 = seeds2 `unionVarSet` tcvs
need_inner = findNeededEvVars ev_binds seeds3
live_ev_binds = filterEvBindMap (needed_ev_bind need_inner) ev_binds
need_outer = foldEvBindMap del_ev_bndr need_inner live_ev_binds
need_outer = varSetMinusEvBindMap need_inner live_ev_binds
`delVarSetList` givens
; TcS.setTcEvBindsMap ev_binds_var live_ev_binds
......@@ -1879,9 +1881,6 @@ neededEvVars implic@(Implic { ic_given = givens
| is_given = ev_var `elemVarSet` needed
| otherwise = True -- Keep all wanted bindings
del_ev_bndr :: EvBind -> VarSet -> VarSet
del_ev_bndr (EvBind { eb_lhs = v }) needs = delVarSet needs v
add_wanted :: EvBind -> VarSet -> VarSet
add_wanted (EvBind { eb_is_given = is_given, eb_rhs = rhs }) needs
| is_given = needs -- Add the rhs vars of the Wanted bindings only
......@@ -2377,7 +2376,7 @@ floatEqualities skols given_ids ev_binds_var no_given_eqs
seed_skols = mkVarSet skols `unionVarSet`
mkVarSet given_ids `unionVarSet`
foldr add_non_flt_ct emptyVarSet no_float_cts `unionVarSet`
foldEvBindMap add_one_bind emptyVarSet binds
evBindMapToVarSet binds
-- seed_skols: See Note [What prevents a constraint from floating] (1,2,3)
-- Include the EvIds of any non-floating constraints
......@@ -2402,9 +2401,6 @@ floatEqualities skols given_ids ev_binds_var no_given_eqs
; return ( flt_eqs, wanteds { wc_simple = remaining_simples } ) }
where
add_one_bind :: EvBind -> VarSet -> VarSet
add_one_bind bind acc = extendVarSet acc (evBindVar bind)
add_non_flt_ct :: Ct -> VarSet -> VarSet
add_non_flt_ct ct acc | isDerivedCt ct = acc
| otherwise = extendVarSet acc (ctEvId ct)
......
......@@ -15,8 +15,12 @@ module GHC.Tc.Types.Evidence (
-- * Evidence bindings
TcEvBinds(..), EvBindsVar(..),
EvBindMap(..), emptyEvBindMap, extendEvBinds,
lookupEvBind, evBindMapBinds, foldEvBindMap, filterEvBindMap,
lookupEvBind, evBindMapBinds,
foldEvBindMap, nonDetStrictFoldEvBindMap,
filterEvBindMap,
isEmptyEvBindMap,
evBindMapToVarSet,
varSetMinusEvBindMap,
EvBind(..), emptyTcEvBinds, isEmptyTcEvBinds, mkGivenEvBind, mkWantedEvBind,
evBindVar, isCoEvBindsVar,
......@@ -55,6 +59,8 @@ module GHC.Tc.Types.Evidence (
import GHC.Prelude
import GHC.Types.Unique.DFM
import GHC.Types.Unique.FM
import GHC.Types.Var
import GHC.Core.Coercion.Axiom
import GHC.Core.Coercion
......@@ -496,10 +502,22 @@ evBindMapBinds = foldEvBindMap consBag emptyBag
foldEvBindMap :: (EvBind -> a -> a) -> a -> EvBindMap -> a
foldEvBindMap k z bs = foldDVarEnv k z (ev_bind_varenv bs)
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
nonDetStrictFoldEvBindMap :: (EvBind -> a -> a) -> a -> EvBindMap -> a
nonDetStrictFoldEvBindMap k z bs = nonDetStrictFoldDVarEnv k z (ev_bind_varenv bs)
filterEvBindMap :: (EvBind -> Bool) -> EvBindMap -> EvBindMap
filterEvBindMap k (EvBindMap { ev_bind_varenv = env })
= EvBindMap { ev_bind_varenv = filterDVarEnv k env }
evBindMapToVarSet :: EvBindMap -> VarSet
evBindMapToVarSet (EvBindMap dve) = unsafeUFMToUniqSet (mapUFM evBindVar (udfmToUfm dve))
varSetMinusEvBindMap :: VarSet -> EvBindMap -> VarSet
varSetMinusEvBindMap vs (EvBindMap dve) = vs `uniqSetMinusUDFM` dve
instance Outputable EvBindMap where
ppr (EvBindMap m) = ppr m
......@@ -851,8 +869,8 @@ findNeededEvVars ev_binds seeds
= transCloVarSet also_needs seeds
where
also_needs :: VarSet -> VarSet
also_needs needs = nonDetFoldUniqSet add emptyVarSet needs
-- It's OK to use nonDetFoldUFM here because we immediately
also_needs needs = nonDetStrictFoldUniqSet add emptyVarSet needs
-- It's OK to use a non-deterministic fold here because we immediately
-- forget about the ordering by creating a set
add :: Var -> VarSet -> VarSet
......
......@@ -693,7 +693,9 @@ tcTyVarLevel tv
tcTypeLevel :: TcType -> TcLevel
-- Max level of any free var of the type
tcTypeLevel ty
= foldDVarSet add topTcLevel (tyCoVarsOfTypeDSet ty)
= nonDetStrictFoldDVarSet add topTcLevel (tyCoVarsOfTypeDSet ty)
-- It's safe to use a non-deterministic fold because `maxTcLevel` is
-- commutative.
where
add v lvl
| isTcTyVar v = lvl `maxTcLevel` tcTyVarLevel v
......
......@@ -785,16 +785,23 @@ cleanUseDmd_maybe _ = Nothing
splitFVs :: Bool -- Thunk
-> DmdEnv -> (DmdEnv, DmdEnv)
splitFVs is_thunk rhs_fvs
| is_thunk = nonDetFoldUFM_Directly add (emptyVarEnv, emptyVarEnv) rhs_fvs
-- It's OK to use nonDetFoldUFM_Directly because we
| is_thunk = strictPairToTuple $
nonDetStrictFoldUFM_Directly add (emptyVarEnv :*: emptyVarEnv) rhs_fvs
-- It's OK to use a non-deterministic fold because we
-- immediately forget the ordering by putting the elements
-- in the envs again
| otherwise = partitionVarEnv isWeakDmd rhs_fvs
where
add uniq dmd@(JD { sd = s, ud = u }) (lazy_fv, sig_fv)
| Lazy <- s = (addToUFM_Directly lazy_fv uniq dmd, sig_fv)
| otherwise = ( addToUFM_Directly lazy_fv uniq (JD { sd = Lazy, ud = u })
, addToUFM_Directly sig_fv uniq (JD { sd = s, ud = Abs }) )
add uniq dmd@(JD { sd = s, ud = u }) (lazy_fv :*: sig_fv)
| Lazy <- s = addToUFM_Directly lazy_fv uniq dmd :*: sig_fv
| otherwise = addToUFM_Directly lazy_fv uniq (JD { sd = Lazy, ud = u })
:*:
addToUFM_Directly sig_fv uniq (JD { sd = s, ud = Abs })
data StrictPair a b = !a :*: !b
strictPairToTuple :: StrictPair a b -> (a, b)
strictPairToTuple (x :*: y) = (x, y)
data TypeShape = TsFun TypeShape
| TsProd [TypeShape]
......
......@@ -50,14 +50,14 @@ module GHC.Types.Unique.DFM (
equalKeysUDFM,
minusUDFM,
listToUDFM,
udfmMinusUFM,
udfmMinusUFM, ufmMinusUDFM,
partitionUDFM,
anyUDFM, allUDFM,
pprUniqDFM, pprUDFM,
udfmToList,
udfmToUfm,
nonDetFoldUDFM,
nonDetStrictFoldUDFM,
alwaysUnsafeUfmToUdfm,
) where
......@@ -72,7 +72,7 @@ import Data.Functor.Classes (Eq1 (..))
import Data.List (sortBy)
import Data.Function (on)
import qualified Data.Semigroup as Semi
import GHC.Types.Unique.FM (UniqFM, listToUFM_Directly, nonDetUFMToList, ufmToIntMap)
import GHC.Types.Unique.FM (UniqFM, nonDetUFMToList, ufmToIntMap, unsafeIntMapToUFM)
-- Note [Deterministic UniqFM]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
......@@ -272,12 +272,14 @@ elemUDFM k (UDFM m _i) = M.member (getKey $ getUnique k) m
foldUDFM :: (elt -> a -> a) -> a -> UniqDFM elt -> a
foldUDFM k z m = foldr k z (eltsUDFM m)
-- | Performs a nondeterministic fold over the UniqDFM.
-- | Performs a nondeterministic strict fold over the UniqDFM.
-- It's O(n), same as the corresponding function on `UniqFM`.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
nonDetFoldUDFM :: (elt -> a -> a) -> a -> UniqDFM elt -> a
nonDetFoldUDFM k z (UDFM m _i) = foldr k z $ map taggedFst $ M.elems m
nonDetStrictFoldUDFM :: (elt -> a -> a) -> a -> UniqDFM elt -> a
nonDetStrictFoldUDFM k z (UDFM m _i) = foldl' k' z m
where
k' acc (TaggedVal v _) = k v acc
eltsUDFM :: UniqDFM elt -> [elt]
eltsUDFM (UDFM m _i) =
......@@ -337,6 +339,9 @@ udfmMinusUFM (UDFM x i) y = UDFM (M.difference x (ufmToIntMap y)) i
-- M.difference returns a subset of a left set, so `i` is a good upper
-- bound.
ufmMinusUDFM :: UniqFM elt1 -> UniqDFM elt2 -> UniqFM elt1
ufmMinusUDFM x (UDFM y _i) = unsafeIntMapToUFM (M.difference (ufmToIntMap x) y)
-- | Partition UniqDFM into two UniqDFMs according to the predicate
partitionUDFM :: (elt -> Bool) -> UniqDFM elt -> (UniqDFM elt, UniqDFM elt)
partitionUDFM p (UDFM m i) =
......@@ -349,8 +354,7 @@ delListFromUDFM = foldl' delFromUDFM
-- | This allows for lossy conversion from UniqDFM to UniqFM
udfmToUfm :: UniqDFM elt -> UniqFM elt
udfmToUfm (UDFM m _i) =
listToUFM_Directly [(getUnique k, taggedFst tv) | (k, tv) <- M.toList m]
udfmToUfm (UDFM m _i) = unsafeIntMapToUFM (M.map taggedFst m)
listToUDFM :: Uniquable key => [(key,elt)] -> UniqDFM elt
listToUDFM = foldl' (\m (k, v) -> addToUDFM m k v) emptyUDFM
......
......@@ -26,7 +26,7 @@ module GHC.Types.Unique.DSet (
unionUniqDSets, unionManyUniqDSets,
minusUniqDSet, uniqDSetMinusUniqSet,
intersectUniqDSets, uniqDSetIntersectUniqSet,
foldUniqDSet,
nonDetStrictFoldUniqDSet,
elementOfUniqDSet,
filterUniqDSet,
sizeUniqDSet,
......@@ -98,8 +98,11 @@ uniqDSetIntersectUniqSet :: UniqDSet a -> UniqSet b -> UniqDSet a
uniqDSetIntersectUniqSet xs ys
= UniqDSet (udfmIntersectUFM (getUniqDSet xs) (getUniqSet ys))
foldUniqDSet :: (a -> b -> b) -> b -> UniqDSet a -> b
foldUniqDSet c n (UniqDSet s) = foldUDFM c n s
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
nonDetStrictFoldUniqDSet :: (a -> b -> b) -> b -> UniqDSet a -> b
nonDetStrictFoldUniqDSet f acc (UniqDSet s) = nonDetStrictFoldUDFM f acc s
elementOfUniqDSet :: Uniquable a => a -> UniqDSet a -> Bool
elementOfUniqDSet k = elemUDFM k . getUniqDSet
......
......@@ -56,7 +56,7 @@ module GHC.Types.Unique.FM (
intersectUFM_C,
disjointUFM,
equalKeysUFM,
nonDetFoldUFM, foldUFM, nonDetFoldUFM_Directly,
nonDetStrictFoldUFM, foldUFM, nonDetStrictFoldUFM_Directly,
anyUFM, allUFM, seqEltsUFM,
mapUFM, mapUFM_Directly,
elemUFM, elemUFM_Directly,
......@@ -67,7 +67,7 @@ module GHC.Types.Unique.FM (
lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
nonDetEltsUFM, eltsUFM, nonDetKeysUFM,
ufmToSet_Directly,
nonDetUFMToList, ufmToIntMap,
nonDetUFMToList, ufmToIntMap, unsafeIntMapToUFM,
pprUniqFM, pprUFM, pprUFMWithKeys, pluralUFM
) where
......@@ -318,14 +318,14 @@ nonDetKeysUFM (UFM m) = map getUnique $ M.keys m
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
nonDetFoldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
nonDetFoldUFM k z (UFM m) = M.foldr k z m
nonDetStrictFoldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
nonDetStrictFoldUFM k z (UFM m) = M.foldl' (flip k) z m
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
nonDetFoldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
nonDetFoldUFM_Directly k z (UFM m) = M.foldrWithKey (k . getUnique) z m
nonDetStrictFoldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
nonDetStrictFoldUFM_Directly k z (UFM m) = M.foldlWithKey' (\z' i x -> k (getUnique i) x z') z m
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
......@@ -359,6 +359,9 @@ instance Traversable NonDetUniqFM where
ufmToIntMap :: UniqFM elt -> M.IntMap elt
ufmToIntMap (UFM m) = m
unsafeIntMapToUFM :: M.IntMap elt -> UniqFM elt
unsafeIntMapToUFM = UFM
-- Determines whether two 'UniqFM's contain the same keys.
equalKeysUFM :: UniqFM a -> UniqFM b -> Bool
equalKeysUFM (UFM m1) (UFM m2) = liftEq (\_ _ -> True) m1 m2
......
......@@ -25,7 +25,7 @@ module GHC.Types.Unique.Set (
delOneFromUniqSet, delOneFromUniqSet_Directly, delListFromUniqSet,
delListFromUniqSet_Directly,
unionUniqSets, unionManyUniqSets,
minusUniqSet, uniqSetMinusUFM,
minusUniqSet, uniqSetMinusUFM, uniqSetMinusUDFM,
intersectUniqSets,
restrictUniqSetToUFM,
uniqSetAny, uniqSetAll,
......@@ -42,12 +42,12 @@ module GHC.Types.Unique.Set (
unsafeUFMToUniqSet,
nonDetEltsUniqSet,
nonDetKeysUniqSet,
nonDetFoldUniqSet,
nonDetFoldUniqSet_Directly
nonDetStrictFoldUniqSet,
) where
import GHC.Prelude
import GHC.Types.Unique.DFM
import GHC.Types.Unique.FM
import GHC.Types.Unique
import Data.Coerce
......@@ -111,6 +111,9 @@ restrictUniqSetToUFM (UniqSet s) m = UniqSet (intersectUFM s m)
uniqSetMinusUFM :: UniqSet a -> UniqFM b -> UniqSet a
uniqSetMinusUFM (UniqSet s) t = UniqSet (minusUFM s t)
uniqSetMinusUDFM :: UniqSet a -> UniqDFM b -> UniqSet a
uniqSetMinusUDFM (UniqSet s) t = UniqSet (ufmMinusUDFM s t)
elementOfUniqSet :: Uniquable a => a -> UniqSet a -> Bool
elementOfUniqSet a (UniqSet s) = elemUFM a s
......@@ -159,14 +162,8 @@ nonDetKeysUniqSet = nonDetKeysUFM . getUniqSet'
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
nonDetFoldUniqSet :: (elt -> a -> a) -> a -> UniqSet elt -> a
nonDetFoldUniqSet c n (UniqSet s) = nonDetFoldUFM c n s
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
nonDetFoldUniqSet_Directly:: (Unique -> elt -> a -> a) -> a -> UniqSet elt -> a
nonDetFoldUniqSet_Directly f n (UniqSet s) = nonDetFoldUFM_Directly f n s
nonDetStrictFoldUniqSet :: (elt -> a -> a) -> a -> UniqSet elt -> a
nonDetStrictFoldUniqSet c n (UniqSet s) = nonDetStrictFoldUFM c n s
-- See Note [UniqSet invariant]
mapUniqSet :: Uniquable b => (a -> b) -> UniqSet a -> UniqSet b
......
......@@ -33,7 +33,7 @@ module GHC.Types.Var.Env (
extendDVarEnv, extendDVarEnv_C,
extendDVarEnvList,
lookupDVarEnv, elemDVarEnv,
isEmptyDVarEnv, foldDVarEnv,
isEmptyDVarEnv, foldDVarEnv, nonDetStrictFoldDVarEnv,
mapDVarEnv, filterDVarEnv,
modifyDVarEnv,
alterDVarEnv,
......@@ -575,6 +575,12 @@ lookupDVarEnv = lookupUDFM
foldDVarEnv :: (a -> b -> b) -> b -> DVarEnv a -> b
foldDVarEnv = foldUDFM
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
nonDetStrictFoldDVarEnv :: (a -> b -> b) -> b -> DVarEnv a -> b
nonDetStrictFoldDVarEnv = nonDetStrictFoldUDFM
mapDVarEnv :: (a -> b) -> DVarEnv a -> DVarEnv b
mapDVarEnv = mapUDFM
......
......@@ -23,7 +23,7 @@ module GHC.Types.Var.Set (
sizeVarSet, seqVarSet,
elemVarSetByKey, partitionVarSet,
pluralVarSet, pprVarSet,
nonDetFoldVarSet,
nonDetStrictFoldVarSet,
-- * Deterministic Var set types
DVarSet, DIdSet, DTyVarSet, DTyCoVarSet,
......@@ -36,7 +36,9 @@ module GHC.Types.Var.Set (
intersectDVarSet, dVarSetIntersectVarSet,
intersectsDVarSet, disjointDVarSet,
isEmptyDVarSet, delDVarSet, delDVarSetList,
minusDVarSet, foldDVarSet, filterDVarSet, mapDVarSet,
minusDVarSet,
nonDetStrictFoldDVarSet,
filterDVarSet, mapDVarSet,
dVarSetMinusVarSet, anyDVarSet, allDVarSet,
transCloDVarSet,
sizeDVarSet, seqDVarSet,
......@@ -152,8 +154,11 @@ allVarSet = uniqSetAll
mapVarSet :: Uniquable b => (a -> b) -> UniqSet a -> UniqSet b
mapVarSet = mapUniqSet
nonDetFoldVarSet :: (Var -> a -> a) -> a -> VarSet -> a
nonDetFoldVarSet = nonDetFoldUniqSet
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
nonDetStrictFoldVarSet :: (Var -> a -> a) -> a -> VarSet -> a
nonDetStrictFoldVarSet = nonDetStrictFoldUniqSet
fixVarSet :: (VarSet -> VarSet) -- Map the current set to a new set
-> VarSet -> VarSet
......@@ -290,8 +295,11 @@ minusDVarSet = minusUniqDSet
dVarSetMinusVarSet :: DVarSet -> VarSet -> DVarSet
dVarSetMinusVarSet = uniqDSetMinusUniqSet
foldDVarSet :: (Var -> a -> a) -> a -> DVarSet -> a
foldDVarSet = foldUniqDSet
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
nonDetStrictFoldDVarSet :: (Var -> a -> a) -> a -> DVarSet -> a
nonDetStrictFoldDVarSet = nonDetStrictFoldUniqDSet
anyDVarSet :: (Var -> Bool) -> DVarSet -> Bool
anyDVarSet p = anyUDFM p . getUniqDSet
......
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