From d6be4b02a3dc057e8c8f96a896b1c29349d3a04e Mon Sep 17 00:00:00 2001 From: meooow25 Date: Fri, 15 May 2026 20:52:36 +0200 Subject: [PATCH] Remove duplicate alter implementation This is only used in an alterF rewrite rule. Update the rule to use alter instead. Benchmarks with GHC 9.14 show minor improvements except for the "absent" case which becomes slower. This case is already documented to be slow in the alterF Haddocks. --- containers/src/Data/Map/Internal.hs | 39 +--------------------- containers/src/Data/Map/Strict/Internal.hs | 5 +-- 2 files changed, 2 insertions(+), 42 deletions(-) diff --git a/containers/src/Data/Map/Internal.hs b/containers/src/Data/Map/Internal.hs index b3bcd056c..0857e07be 100644 --- a/containers/src/Data/Map/Internal.hs +++ b/containers/src/Data/Map/Internal.hs @@ -350,9 +350,6 @@ module Data.Map.Internal ( -- Used by the strict version , AreWeStrict (..) , atKeyImpl -#ifdef __GLASGOW_HASKELL__ - , atKeyPlain -#endif , bin , balance , balanceL @@ -1348,42 +1345,8 @@ replaceAlong q x (Bin sz ky y l r) = #ifdef __GLASGOW_HASKELL__ atKeyIdentity :: Ord k => k -> (Maybe a -> Identity (Maybe a)) -> Map k a -> Identity (Map k a) -atKeyIdentity k f t = Identity $ atKeyPlain Lazy k (coerce f) t +atKeyIdentity k f t = Identity (alter (coerce f) k t) {-# INLINABLE atKeyIdentity #-} - -atKeyPlain :: Ord k => AreWeStrict -> k -> (Maybe a -> Maybe a) -> Map k a -> Map k a -atKeyPlain strict k0 f0 t = case go k0 f0 t of - AltSmaller t' -> t' - AltBigger t' -> t' - AltAdj t' -> t' - AltSame -> t - where - go :: Ord k => k -> (Maybe a -> Maybe a) -> Map k a -> Altered k a - go !k f Tip = case f Nothing of - Nothing -> AltSame - Just x -> case strict of - Lazy -> AltBigger $ singleton k x - Strict -> x `seq` (AltBigger $ singleton k x) - - go k f (Bin sx kx x l r) = case compare k kx of - LT -> case go k f l of - AltSmaller l' -> AltSmaller $ balanceR kx x l' r - AltBigger l' -> AltBigger $ balanceL kx x l' r - AltAdj l' -> AltAdj $ Bin sx kx x l' r - AltSame -> AltSame - GT -> case go k f r of - AltSmaller r' -> AltSmaller $ balanceL kx x l r' - AltBigger r' -> AltBigger $ balanceR kx x l r' - AltAdj r' -> AltAdj $ Bin sx kx x l r' - AltSame -> AltSame - EQ -> case f (Just x) of - Just x' -> case strict of - Lazy -> AltAdj $ Bin sx kx x' l r - Strict -> x' `seq` (AltAdj $ Bin sx kx x' l r) - Nothing -> AltSmaller $ glue l r -{-# INLINE atKeyPlain #-} - -data Altered k a = AltSmaller !(Map k a) | AltBigger !(Map k a) | AltAdj !(Map k a) | AltSame #endif #ifdef DEFINE_ALTERF_FALLBACK diff --git a/containers/src/Data/Map/Strict/Internal.hs b/containers/src/Data/Map/Strict/Internal.hs index 7275b9bf8..1c7ac7534 100644 --- a/containers/src/Data/Map/Strict/Internal.hs +++ b/containers/src/Data/Map/Strict/Internal.hs @@ -331,9 +331,6 @@ import Data.Map.Internal , argSet , assocs , atKeyImpl -#ifdef __GLASGOW_HASKELL__ - , atKeyPlain -#endif , balance , balanceL , balanceR @@ -801,7 +798,7 @@ alterF f k m = atKeyImpl Strict k f m #-} atKeyIdentity :: Ord k => k -> (Maybe a -> Identity (Maybe a)) -> Map k a -> Identity (Map k a) -atKeyIdentity k f t = Identity $ atKeyPlain Strict k (coerce f) t +atKeyIdentity k f t = Identity (alter (coerce f) k t) {-# INLINABLE atKeyIdentity #-} #endif