summaryrefslogtreecommitdiff
path: root/compiler/GHC/Types/Unique/FM.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Types/Unique/FM.hs')
-rw-r--r--compiler/GHC/Types/Unique/FM.hs11
1 files changed, 8 insertions, 3 deletions
diff --git a/compiler/GHC/Types/Unique/FM.hs b/compiler/GHC/Types/Unique/FM.hs
index 7c80359d0e..0d43111c2a 100644
--- a/compiler/GHC/Types/Unique/FM.hs
+++ b/compiler/GHC/Types/Unique/FM.hs
@@ -63,7 +63,7 @@ module GHC.Types.Unique.FM (
intersectUFM_C,
disjointUFM,
equalKeysUFM,
- nonDetStrictFoldUFM, foldUFM, nonDetStrictFoldUFM_Directly,
+ nonDetStrictFoldUFM, foldUFM, nonDetStrictFoldUFM_DirectlyM,
anyUFM, allUFM, seqEltsUFM,
mapUFM, mapUFM_Directly,
elemUFM, elemUFM_Directly,
@@ -405,11 +405,16 @@ nonDetKeysUFM (UFM m) = map getUnique $ M.keys m
nonDetStrictFoldUFM :: (elt -> a -> a) -> a -> UniqFM key elt -> a
nonDetStrictFoldUFM k z (UFM m) = M.foldl' (flip k) z m
+-- | In essence foldM
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
-nonDetStrictFoldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM key elt -> a
-nonDetStrictFoldUFM_Directly k z (UFM m) = M.foldlWithKey' (\z' i x -> k (getUnique i) x z') z m
+{-# INLINE nonDetStrictFoldUFM_DirectlyM #-} -- Allow specialization
+nonDetStrictFoldUFM_DirectlyM :: (Monad m) => (Unique -> b -> elt -> m b) -> b -> UniqFM key elt -> m b
+nonDetStrictFoldUFM_DirectlyM f z0 (UFM xs) = M.foldrWithKey c return xs z0
+ -- See Note [List fusion and continuations in 'c']
+ where c u x k z = f (getUnique u) z x >>= k
+ {-# INLINE c #-}
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce