Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Only call runST once in insertWith'

Improves performance by 10% on insert/Int.  Before this change we used
to (implicitly) call runST once per level of the tree, causing
closures to be allocated.
  • Loading branch information...
commit 58b7815a057b3575c58b746d5971d59d806b1333 1 parent 7c19a6d
@tibbe authored
Showing with 64 additions and 42 deletions.
  1. +33 −17 Data/HashMap/Array.hs
  2. +31 −25 Data/HashMap/Base.hs
View
50 Data/HashMap/Array.hs
@@ -11,6 +11,7 @@ module Data.HashMap.Array
, new
, new_
, singleton
+ , singleton'
, pair
-- * Basic interface
@@ -22,8 +23,10 @@ module Data.HashMap.Array
, index_
, indexM_
, update
+ , update'
, updateWith
, insert
+ , insert'
, delete
, unsafeFreeze
@@ -145,9 +148,13 @@ new_ :: Int -> ST s (MArray s a)
new_ n = new n undefinedElem
singleton :: a -> Array a
-singleton x = run (new 1 x)
+singleton x = runST (singleton' x)
{-# INLINE singleton #-}
+singleton' :: a -> ST s (Array a)
+singleton' x = new 1 x >>= unsafeFreeze
+{-# INLINE singleton' #-}
+
pair :: a -> a -> Array a
pair x y = run $ do
ary <- new 2 x
@@ -249,28 +256,37 @@ copyM !src !sidx !dst !didx n =
-- | /O(n)/ Insert an element at the given position in this array,
-- increasing its size by one.
insert :: Array e -> Int -> e -> Array e
-insert ary idx b =
- CHECK_BOUNDS("insert", count + 1, idx)
- run $ do
- mary <- new_ (count+1)
- copy ary 0 mary 0 idx
- write mary idx b
- copy ary idx mary (idx+1) (count-idx)
- return mary
- where !count = length ary
+insert ary idx b = runST (insert' ary idx b)
{-# INLINE insert #-}
+-- | /O(n)/ Insert an element at the given position in this array,
+-- increasing its size by one.
+insert' :: Array e -> Int -> e -> ST s (Array e)
+insert' ary idx b =
+ CHECK_BOUNDS("insert'", count + 1, idx)
+ do mary <- new_ (count+1)
+ copy ary 0 mary 0 idx
+ write mary idx b
+ copy ary idx mary (idx+1) (count-idx)
+ unsafeFreeze mary
+ where !count = length ary
+{-# INLINE insert' #-}
+
-- | /O(n)/ Update the element at the given position in this array.
update :: Array e -> Int -> e -> Array e
-update ary idx b =
- CHECK_BOUNDS("update", count, idx)
- run $ do
- mary <- thaw ary 0 count
- write mary idx b
- return mary
- where !count = length ary
+update ary idx b = runST (update' ary idx b)
{-# INLINE update #-}
+-- | /O(n)/ Update the element at the given position in this array.
+update' :: Array e -> Int -> e -> ST s (Array e)
+update' ary idx b =
+ CHECK_BOUNDS("update'", count, idx)
+ do mary <- thaw ary 0 count
+ write mary idx b
+ unsafeFreeze mary
+ where !count = length ary
+{-# INLINE update' #-}
+
-- | /O(n)/ Update the element at the given positio in this array, by
-- applying a function to it. Evaluates the element to WHNF before
-- inserting it into the array.
View
56 Data/HashMap/Base.hs
@@ -250,34 +250,36 @@ insertWith = insertWith'
-- pay the cost of using the higher-order argument.
insertWith' :: (Eq k, Hashable k) => (v -> v -> v) -> k -> v -> HashMap k v
-> HashMap k v
-insertWith' f k0 v0 = go h0 k0 v0 0
+insertWith' f k0 v0 m0 = runST (go h0 k0 v0 0 m0)
where
h0 = hash k0
- go !h !k x !_ Empty = Leaf h (L k x)
+ go !h !k x !_ Empty = return $! Leaf h (L k x)
go h k x s t@(Leaf hy l@(L ky y))
| hy == h = if ky == k
- then Leaf h (L k (f x y))
- else collision h l (L k x)
- | otherwise = go h k x s $ BitmapIndexed (bitpos hy s) (A.singleton t)
+ then return $! Leaf h (L k (f x y))
+ else return $! collision h l (L k x)
+ | otherwise = do
+ leaf <- A.singleton' t
+ go h k x s $ BitmapIndexed (bitpos hy s) leaf
go h k x s (BitmapIndexed b ary)
- | b .&. m == 0 = let l = Leaf h (L k x)
- ary' = A.insert ary i $! l
- b' = b .|. m
- in bitmapIndexedOrFull b' ary'
- | otherwise = let st = A.index ary i
- st' = go h k x (s+bitsPerSubkey) st
- ary' = A.update ary i $! st'
- in BitmapIndexed b ary'
+ | b .&. m == 0 = do
+ ary' <- A.insert' ary i $! Leaf h (L k x)
+ return $! bitmapIndexedOrFull (b .|. m) ary'
+ | otherwise = do
+ st <- A.index_ ary i
+ st' <- go h k x (s+bitsPerSubkey) st
+ ary' <- A.update' ary i st'
+ return $! BitmapIndexed b ary'
where m = bitpos h s
i = index b m
- go h k x s (Full ary) =
- let i = mask h s
- st = A.index ary i
- st' = go h k x (s+bitsPerSubkey) st
- ary' = update16 ary i $! st'
- in Full ary'
+ go h k x s (Full ary) = do
+ st <- A.index_ ary i
+ st' <- go h k x (s+bitsPerSubkey) st
+ ary' <- update16' ary i st'
+ return $! Full ary'
+ where i = mask h s
go h k x s t@(Collision hy v)
- | h == hy = Collision h (updateOrSnocWith f k x v)
+ | h == hy = return $! Collision h (updateOrSnocWith f k x v)
| otherwise = go h k x s $ BitmapIndexed (bitpos hy s) (A.singleton t)
{-# INLINE insertWith' #-}
@@ -792,13 +794,17 @@ updateOrConcatWith f ary1 ary2 = A.run $ do
-- | /O(n)/ Update the element at the given position in this array.
update16 :: A.Array e -> Int -> e -> A.Array e
-update16 ary idx b =
- A.run $ do
- mary <- clone16 ary
- A.write mary idx b
- return mary
+update16 ary idx b = runST (update16' ary idx b)
{-# INLINE update16 #-}
+-- | /O(n)/ Update the element at the given position in this array.
+update16' :: A.Array e -> Int -> e -> ST s (A.Array e)
+update16' ary idx b = do
+ mary <- clone16 ary
+ A.write mary idx b
+ A.unsafeFreeze mary
+{-# INLINE update16' #-}
+
-- | /O(n)/ Update the element at the given position in this array, by applying a function to it.
update16With :: A.Array e -> Int -> (e -> e) -> A.Array e
update16With ary idx f = update16 ary idx $! f (A.index ary idx)
Please sign in to comment.
Something went wrong with that request. Please try again.