Skip to content

Commit

Permalink
Fix 'unsafeInsertWithInternal' in Strict module
Browse files Browse the repository at this point in the history
This commit fixes the 'unsafeInsertWithInternal' function.

The value-strictness test for 'fromListWith' was failing because
a comparison between two hashmaps was failing since their
size-tracking field differed.

This was due to the insertion function used by 'fromListWith'
not updating the hashmap's size correctly when a leaf which does
not collide with any other leaves in the hashmap was inserted in
it.

The 'unsafeInsertWithInternal' function was also updated with more
'$!' operators to reduce parentheses.
  • Loading branch information
rockbmb committed Oct 12, 2017
1 parent 3f6c515 commit a4f9bc6
Showing 1 changed file with 13 additions and 11 deletions.
24 changes: 13 additions & 11 deletions Data/HashMap/Strict.hs
Original file line number Diff line number Diff line change
Expand Up @@ -163,7 +163,7 @@ insertWithInternal f k0 v0 m0 = go h0 k0 v0 0 m0
| hy == h = if ky == k
then A.Sized 0 (leaf h k (f x y))
else A.Sized 1 (x `seq` (collision h l (L k x)))
| otherwise = A.Sized 0 (x `seq` runST (two s h k x hy ky y))
| otherwise = A.Sized 1 (x `seq` runST (two s h k x hy ky y))
go h k x s (BitmapIndexed b ary)
| b .&. m == 0 =
let ary' = A.insert ary i $! leaf h k x
Expand Down Expand Up @@ -210,37 +210,39 @@ unsafeInsertWithInternal
unsafeInsertWithInternal f k0 v0 m0 = runST (go h0 k0 v0 0 m0)
where
h0 = hash k0
go !h !k x !_ Empty = return $! A.Sized 1 (leaf h k x)
go !h !k x !_ Empty = return . A.Sized 1 $! leaf h k x
go h k x s (Leaf hy l@(L ky y))
| hy == h = if ky == k
then return $! A.Sized 0 (leaf h k (f x y))
then return . A.Sized 0 $! leaf h k (f x y)
else do
let l' = x `seq` (L k x)
return $! A.Sized 1 (collision h l l')
| otherwise = (x `seq` two s h k x hy ky y) >>= return . A.Sized 1
return . A.Sized 1 $! collision h l l'
| otherwise = do
twoHM <- x `seq` two s h k x hy ky y
return . A.Sized 1 $! twoHM
go h k x s t@(BitmapIndexed b ary)
| b .&. m == 0 = do
ary' <- A.insertM ary i $! leaf h k x
return $! A.Sized 1 (bitmapIndexedOrFull (b .|. m) ary')
return . A.Sized 1 $! bitmapIndexedOrFull (b .|. m) ary'
| otherwise = do
st <- A.indexM ary i
A.Sized sz st' <- go h k x (s+bitsPerSubkey) st
A.unsafeUpdateM ary i st'
return (A.Sized sz t)
A.unsafeUpdateM ary i $! st'
return . A.Sized sz $! t
where m = mask h s
i = sparseIndex b m
go h k x s t@(Full ary) = do
st <- A.indexM ary i
A.Sized sz st' <- go h k x (s+bitsPerSubkey) st
A.unsafeUpdateM ary i st'
return (A.Sized sz t)
A.unsafeUpdateM ary i $! st'
return . A.Sized sz $! t
where i = index h s
go h k x s t@(Collision hy v)
| h == hy =
let !start = A.length v
!newV = updateOrSnocWith f k x v
!end = A.length newV
in return $! A.Sized (end - start) (Collision h newV)
in return . A.Sized (end - start) $! Collision h newV
| otherwise = go h k x s $ BitmapIndexed (mask hy s) (A.singleton t)
{-# INLINABLE unsafeInsertWithInternal #-}

Expand Down

0 comments on commit a4f9bc6

Please sign in to comment.