cleanup

Author: oberblastmeister

Data/HashMap/Internal.hs

@@ -1591,6 +1591,10 @@ unionWithKey f = go 0
             ary' = update32With' ary2 i $ \st2 -> go (s+bitsPerSubkey) t1 st2
         in Full ary'
 
+    leafHashCode (Leaf h _) = h
+    leafHashCode (Collision h _) = h
+    leafHashCode _ = error "leafHashCode"
+
     goDifferentHash s h1 h2 t1 t2
         | m1 == m2  = BitmapIndexed m1 (A.singleton $! goDifferentHash (s+bitsPerSubkey) h1 h2 t1 t2)
         | m1 <  m2  = BitmapIndexed (m1 .|. m2) (A.pair t1 t2)
@@ -1866,7 +1870,7 @@ intersectionArrayBy f !b1 !b2 !ary1 !ary2 = do
 intersectionCollisions :: Eq k => (k -> v1 -> v2 -> (# v3 #)) -> A.Array (Leaf k v1) -> A.Array (Leaf k v2) -> ST s (Int, A.MArray s (Leaf k v3))
 intersectionCollisions f ary1 ary2 = do
   mary2 <- A.thaw ary2 0 $ A.length ary2
-  mary <- A.new_ $ A.length ary1 + A.length ary2
+  mary <- A.new_ $ min (A.length ary1) (A.length ary2)
   let go i j
         | i >= A.length ary1 || j >= A.lengthM mary2 = pure j
         | otherwise = do
@@ -2382,12 +2386,6 @@ ptrEq :: a -> a -> Bool
 ptrEq x y = Exts.isTrue# (Exts.reallyUnsafePtrEquality# x y ==# 1#)
 {-# INLINE ptrEq #-}
 
-leafHashCode :: HashMap k v -> Hash
-leafHashCode (Leaf h _) = h
-leafHashCode (Collision h _) = h
-leafHashCode _ = error "leafHashCode"
-{-# INLINE leafHashCode #-}
-
 ------------------------------------------------------------------------
 -- IsList instance
 instance (Eq k, Hashable k) => Exts.IsList (HashMap k v) where

benchmarks/Benchmarks.hs

@@ -318,13 +318,17 @@ main = do
             [ bench "Int" $ whnf (HM.union hmi) hmi2
             , bench "ByteString" $ whnf (HM.union hmbs) hmbsSubset
             ]
+          
+          , bgroup "intersection"
+            [ bench "Int" $ whnf (HM.intersection hmi) hmi2
+            , bench "ByteString" $ whnf (HM.intersection hmbs) hmbsSubset
+            ]
 
             -- Transformations
           , bench "map" $ whnf (HM.map (\ v -> v + 1)) hmi
 
             -- * Difference and intersection
           , bench "difference" $ whnf (HM.difference hmi) hmi2
-          , bench "intersection" $ whnf (HM.intersection hmi) hmi2
 
             -- Folds
           , bench "foldl'" $ whnf (HM.foldl' (+) 0) hmi

tests/Properties/HashMapLazy.hs

@@ -18,7 +18,6 @@ import Control.Applicative      (Const (..))
 import Control.Monad            (guard)
 import Data.Bifoldable
 import Data.Function            (on)
-import Debug.Trace (traceId)
 import Data.Functor.Identity    (Identity (..))
 import Data.Hashable            (Hashable (hashWithSalt))
 import Data.Ord                 (comparing)
@@ -252,15 +251,7 @@ pSubmapDifference m1 m2 = HM.isSubmapOf (HM.difference m1 m2) m1
 
 pNotSubmapDifference :: HashMap Key Int -> HashMap Key Int -> Property
 pNotSubmapDifference m1 m2 =
-  not (HM.null (HM.intersection m1 m2)) ==> do
-
-  let
-      res = HM.intersection m1 m2
-      res' = M.intersection (M.fromList $ HM.toList m1) (M.fromList $ HM.toList m2)
-      -- !_ = traceId $ "res: " ++ show res
-      -- !_ = traceId $ "res': " ++ show res'
-      -- !_ = traceId $ "m1: " ++ show m1
-      -- !_ = traceId $ "m2: " ++ show m2
+  not (HM.null (HM.intersection m1 m2)) ==>
   not (HM.isSubmapOf m1 (HM.difference m1 m2))
 
 pSubmapDelete :: HashMap Key Int -> Property
@@ -334,9 +325,6 @@ pIntersection xs ys =
     `eq_` HM.intersection (HM.fromList xs)
     $ ys
 
-intersectionBad :: Assertion
-intersectionBad = pIntersection [(-20, 0), (0, 0)] [(0, 0), (20, 0)] @? "should be true"
-
 pIntersectionWith :: [(Key, Int)] -> [(Key, Int)] -> Bool
 pIntersectionWith xs ys = M.intersectionWith (-) (M.fromList xs) `eq_`
                           HM.intersectionWith (-) (HM.fromList xs) $ ys
@@ -547,7 +535,6 @@ tests =
       [ testProperty "difference" pDifference
       , testProperty "differenceWith" pDifferenceWith
       , testProperty "intersection" pIntersection
-      , testCase "intersectionBad" intersectionBad
       , testProperty "intersectionWith" pIntersectionWith
       , testProperty "intersectionWithKey" pIntersectionWithKey
       ]