Skip to content
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
60 changes: 30 additions & 30 deletions Data/HashMap/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1158,56 +1158,56 @@ unsafeInsertWithKey f k0 v0 m0 = runST (go h0 k0 v0 0 m0)
-- | \(O(\log n)\) Remove the mapping for the specified key from this map
-- if present.
delete :: Hashable k => k -> HashMap k v -> HashMap k v
delete k m = delete' (hash k) k m
{-# INLINABLE delete #-}
delete k = delete' (hash k) k
{-# INLINE delete #-}

delete' :: Eq k => Hash -> k -> HashMap k v -> HashMap k v
delete' h0 k0 m0 = deleteFromSubtree h0 k0 0 m0
{-# INLINABLE delete' #-}
delete' = deleteFromSubtree 0
{-# INLINE delete' #-}

-- | This version of 'delete' can be used on subtrees when a the
-- | This version of 'delete' can be used on a subtree when the
-- corresponding 'Shift' argument is supplied.
deleteFromSubtree :: Eq k => Hash -> k -> Shift -> HashMap k v -> HashMap k v
deleteFromSubtree !_ !_ !_ Empty = Empty
deleteFromSubtree h k _ t@(Leaf hy (L ky _))
| hy == h && ky == k = Empty
| otherwise = t
deleteFromSubtree h k s t@(BitmapIndexed b ary)
| b .&. m == 0 = t
| otherwise
= case A.index# ary i of
deleteFromSubtree :: Eq k => Shift -> Hash -> k -> HashMap k v -> HashMap k v
deleteFromSubtree !s !h !k = \case
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm a bit unhappy about the forcing of keys. The upside is that key types likes Int and ShortByteString are unboxed. The downside is that key types that can't be unboxed to an unlifted representation are unnecessarily evaluated again and again.

Maybe we can use Strict# for this, once it's released?!

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Where/why are keys getting re-forced?

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

They are forced once for each subtree we check. So probably ~1–5 times for a typical HashMap.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

You're only forcing the key to get it to unbox, right? So you need the function to be strict in the key when the key is an unboxable type. The function is "naturally" strict in the key for (non-trivial, non-pathological) unboxable types whenever its hash is present in the map (because you'll test key equality). So I believe you should only need to add explicit strictness in the key where you discover that its hash is not in the map.

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Interesting! I agree with your reasoning but I doubt that GHC's strictness analyser could be convinced to believe it too! 😄

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I bet it can, but I need to go back to sleep.

Empty -> Empty
t@(Leaf hy (L ky _))
| hy == h && ky == k -> Empty
| otherwise -> t
t@(BitmapIndexed b ary)
| b .&. m == 0 -> t
| otherwise -> case A.index# ary i of
(# !st #) ->
case deleteFromSubtree h k (nextShift s) st of
case deleteFromSubtree (nextShift s) h k st of
Empty | A.length ary == 2
, (# l #) <- A.index# ary (otherOfOneOrZero i)
, isLeafOrCollision l
-> l
| otherwise
-> BitmapIndexed (b .&. complement m) (A.delete ary i)
st' | isLeafOrCollision st' && A.length ary == 1 -> st'
| st' `ptrEq` st -> t
st' | st' `ptrEq` st -> t
| isLeafOrCollision st' && A.length ary == 1 -> st'
Comment on lines +1187 to +1188
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This change slightly reduces the code size by moving the pointer-eq check to an earlier point. Only afterwards do we differentiate the alternatives for Leaf, Collision etc.

| otherwise -> BitmapIndexed b (A.update ary i st')
where m = mask h s
i = sparseIndex b m
deleteFromSubtree h k s t@(Full ary) =
where m = mask h s
i = sparseIndex b m
t@(Full ary) ->
case A.index# ary i of
(# !st #) ->
case deleteFromSubtree h k (nextShift s) st of
case deleteFromSubtree (nextShift s) h k st of
Empty ->
let ary' = A.delete ary i
bm = fullBitmap .&. complement (1 `unsafeShiftL` i)
in BitmapIndexed bm ary'
st' | st' `ptrEq` st -> t
| otherwise -> Full (updateFullArray ary i st')
where i = index h s
deleteFromSubtree h k _ t@(Collision hy v)
where i = index h s
t@(Collision hy ary)
| h == hy
, Just i <- indexOf k v
= if A.length v == 2
then case A.index# v (otherOfOneOrZero i) of
(# l #) -> Leaf h l
else Collision h (A.delete v i)
| otherwise = t
, Just i <- indexOf k ary
-> if A.length ary == 2
then case A.index# ary (otherOfOneOrZero i) of
(# l #) -> Leaf h l
else Collision h (A.delete ary i)
| otherwise -> t
{-# INLINABLE deleteFromSubtree #-}

-- | Delete optimized for the case when we know the key is in the map.
Expand Down Expand Up @@ -1845,7 +1845,7 @@ difference = go_difference 0
go_difference s t1@(Leaf h1 (L k1 _)) t2
= lookupCont (\_ -> t1) (\_ _ -> Empty) h1 k1 s t2
go_difference _ t1 Empty = t1
go_difference s t1 (Leaf h2 (L k2 _)) = deleteFromSubtree h2 k2 s t1
go_difference s t1 (Leaf h2 (L k2 _)) = deleteFromSubtree s h2 k2 t1

go_difference s t1@(BitmapIndexed b1 ary1) (BitmapIndexed b2 ary2)
= differenceArrays s b1 ary1 t1 b2 ary2
Expand Down