add to strict HashMap

Author: oberblastmeister

Data/HashMap/Internal.hs

@@ -1273,7 +1273,7 @@ update f = Exts.inline alter (>>= f)
 -- 'lookup' k ('alter' f k m) = f ('lookup' k m)
 -- @
 alter :: (Eq k, Hashable k) => (Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
-alter f k = alter' f (hash k) k
+alter f k = Exts.inline alter' f (hash k) k
 {-# INLINABLE alter #-}
 
 alter' :: Eq k => (Maybe v -> Maybe v) -> Hash -> k -> HashMap k v -> HashMap k v

Data/HashMap/Internal/Strict.hs

@@ -299,7 +299,7 @@ adjust f k0 m0 = go h0 k0 0 m0
 -- (if it is in the map). If @(f x)@ is 'Nothing', the element is deleted.
 -- If it is @('Just' y)@, the key @k@ is bound to the new value @y@.
 update :: (Eq k, Hashable k) => (a -> Maybe a) -> k -> HashMap k a -> HashMap k a
-update f = alter (>>= f)
+update f = Exts.inline alter (>>= f)
 {-# INLINABLE update #-}
 
 -- | \(O(\log n)\)  The expression @('alter' f k map)@ alters the value @x@ at @k@, or
@@ -311,19 +311,9 @@ update f = alter (>>= f)
 -- 'lookup' k ('alter' f k m) = f ('lookup' k m)
 -- @
 alter :: (Eq k, Hashable k) => (Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
-alter f k m =
-    let !h = hash k
-        !lookupRes = HM.lookupRecordCollision h k m
-    in case f (HM.lookupResToMaybe lookupRes) of
-        Nothing -> case lookupRes of
-            Absent            -> m
-            Present _ collPos -> HM.deleteKeyExists collPos h k m
-        Just !v' -> case lookupRes of
-            Absent             -> HM.insertNewKey h k v' m
-            Present v collPos ->
-                if v `ptrEq` v'
-                    then m
-                    else HM.insertKeyExists collPos h k v' m
+alter f = Exts.inline HM.alter $ \m -> case f m of
+  Nothing -> Nothing
+  Just !x -> Just x
 {-# INLINABLE alter #-}
 
 -- | \(O(\log n)\)  The expression (@'alterF' f k map@) alters the value @x@ at

unordered-containers.cabal

@@ -69,8 +69,8 @@ library
     MagicHash,
     BangPatterns
 
-  -- ghc-options: -Wall -O2 -fwarn-tabs -ferror-spans
-  ghc-options: -Wall -fwarn-tabs -ferror-spans
+  ghc-options: -Wall -O2 -fwarn-tabs -ferror-spans
+  -- ghc-options: -Wall -fwarn-tabs -ferror-spans
 
   -- For dumping the generated code:
   -- ghc-options: -ddump-simpl -ddump-stg-final -ddump-cmm -ddump-asm -ddump-to-file