Skip to content

Lazy.fromListWith leaks references to keys?! #382

New issue
New issue
Closed
#386
Closed
Lazy.fromListWith leaks references to keys?!#382
#386
Assignees
sjakobi
Labels
bugperformance
@sjakobi

Description

@sjakobi
sjakobi
opened on Mar 19, 2022

I believe that the thunks created by the combining function contain unnecessary references to the map keys.

unordered-containers/Data/HashMap/Internal.hs

Lines 2077 to 2079 in f1ea9a4

fromListWith :: (Eq k, Hashable k) => (v -> v -> v) -> [(k, v)] -> HashMap k v
fromListWith f = List.foldl' (\ m (k, v) -> unsafeInsertWith f k v m) empty
{-# INLINE fromListWith #-}

unordered-containers/Data/HashMap/Internal.hs

Lines 1026 to 1066 in f1ea9a4

-- | In-place update version of insertWith
unsafeInsertWith :: forall k v. (Eq k, Hashable k)
=> (v -> v -> v) -> k -> v -> HashMap k v
-> HashMap k v
unsafeInsertWith f k0 v0 m0 = unsafeInsertWithKey (const f) k0 v0 m0
{-# INLINABLE unsafeInsertWith #-}
unsafeInsertWithKey :: forall k v. (Eq k, Hashable k)
=> (k -> v -> v -> v) -> k -> v -> HashMap k v
-> HashMap k v
unsafeInsertWithKey f k0 v0 m0 = runST (go h0 k0 v0 0 m0)
where
h0 = hash k0
go :: Hash -> k -> v -> Shift -> HashMap k v -> ST s (HashMap k v)
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 return $! Leaf h (L k (f k x y))
else return $! collision h l (L k x)
| otherwise = two s h k x hy t
go h k x s t@(BitmapIndexed b ary)
| b .&. m == 0 = do
ary' <- A.insertM ary i $! Leaf h (L k x)
return $! bitmapIndexedOrFull (b .|. m) ary'
| otherwise = do
st <- A.indexM ary i
st' <- go h k x (s+bitsPerSubkey) st
A.unsafeUpdateM ary i st'
return t
where m = mask h s
i = sparseIndex b m
go h k x s t@(Full ary) = do
st <- A.indexM ary i
st' <- go h k x (s+bitsPerSubkey) st
A.unsafeUpdateM ary i st'
return t
where i = index h s
go h k x s t@(Collision hy v)
| h == hy = return $! Collision h (updateOrSnocWithKey (\key a b -> (# f key a b #) ) k x v)
| otherwise = go h k x s $ BitmapIndexed (mask hy s) (A.singleton t)
{-# INLINABLE unsafeInsertWithKey #-}

Core:

fromListWith
  = \ (@k)
      (@v)
      _ [Occ=Dead]
      ($dHashable :: Hashable k)
      (eta :: v -> v -> v)
      (eta1 :: [(k, v)]) ->
      joinrec {
        go1 [Occ=LoopBreaker, Dmd=SCS(C1(L))]
          :: [(k, v)] -> HashMap k v -> HashMap k v
        [LclId[JoinId(2)], Arity=2, Str=<1L><1L>, Unf=OtherCon []]
        go1 (ds :: [(k, v)]) (eta2 [OS=OneShot] :: HashMap k v)
          = case ds of {
              [] -> eta2;
              : y ys ->
                case y of { (k1, v1) ->
                jump go1
                  ys
                  ($wunsafeInsertWithKey
                     @k @v $dHashable (\ _ [Occ=Dead] -> eta) k1 v1 eta2)
                }
            }; } in
      jump go1 eta1 (Empty @k @v)

Metadata

Metadata

Assignees

Labels

bugperformance

Type

No type

Projects

No projects

Milestone

No milestone

Relationships

None yet

Development

No branches or pull requests

Issue actions