WIP

Author: sjakobi

benchmarks/FineGrained.hs

@@ -62,6 +62,20 @@ env' size setup run =
     )
     (\x -> bench (show size) (run x))
 
+env'' ::
+  (NFData env) =>
+  (Int -> IOGenM StdGen -> IO env) ->
+  (Int -> env -> Benchmark) ->
+  Int ->
+  Benchmark
+env'' setup b size =
+  env
+    ( do
+        gen <- newIOGenM defaultGen
+        setup size gen
+    )
+    (b size)
+
 bFromList :: Benchmark
 bFromList =
   bgroup
@@ -91,13 +105,23 @@ bUnionDisjoint =
   where
     run :: (Hashable a) => (HashMap a Int, HashMap a Int) -> Benchmarkable
     run = whnf (\(as, bs) -> HM.union as bs)
-    setupBytes s gen = do
-      (trues, falses) <- Key.Bytes.genDisjoint s bytesLength gen
-      return (keysToMap trues, keysToMap falses)
-    setupInts s gen = do
-      ints <- genInts s gen
-      let (trues, falses) = Data.List.partition (flip testBit (31 :: Int)) ints
-      return (keysToMap trues, keysToMap falses)
+    setupBytes = genBytesMapsDisjoint
+    setupInts = genIntMapsDisjoint
+
+genIntMapsDisjoint ::
+  (StatefulGen g m) =>
+  Int -> g -> m (HashMap Int Int, HashMap Int Int)
+genIntMapsDisjoint s gen = do
+  ints <- genInts s gen
+  let (trues, falses) = Data.List.partition (flip testBit (31 :: Int)) ints
+  return (keysToMap trues, keysToMap falses)
+
+genBytesMapsDisjoint ::
+  (StatefulGen g m) =>
+  Int -> g -> m (HashMap Bytes Int, HashMap Bytes Int)
+genBytesMapsDisjoint s gen = do
+  (trues, falses) <- Key.Bytes.genDisjoint s bytesLength gen
+  return (keysToMap trues, keysToMap falses)
 
 -- TODO: Separate benchmarks for overlap with pointer eq?!
 bUnionOverlap :: [Benchmark]
@@ -108,70 +132,94 @@ bUnionOverlap =
   where
     run :: (Hashable a) => (HashMap a Int, HashMap a Int) -> Benchmarkable
     run = whnf (\(as, bs) -> HM.union as bs)
-    setupBytes s gen = do
-      (trues, falses) <- Key.Bytes.genDisjoint s bytesLength gen
-      let (a_sep, b_sep) = splitAt (s `div` 4) trues
-      return
-        ( keysToMap falses `HM.union` keysToMap a_sep,
-          keysToMap falses `HM.union` keysToMap b_sep
-        )
-    setupInts s gen = do
-      let s_overlap = s `div` 2
-      let s_a_sep = (s - s_overlap) `div` 2
-      let s_b_sep = s - s_overlap - s_a_sep
-      overlap <- genInts s_overlap gen
-      a_sep <- genInts s_a_sep gen
-      b_sep <- genInts s_b_sep gen
-      return
-        ( keysToMap overlap `HM.union` keysToMap a_sep,
-          keysToMap overlap `HM.union` keysToMap b_sep
-        )
+    setupBytes = genBytesMapsOverlap
+    setupInts = genIntMapsOverlap
+
+genBytesMapsOverlap ::
+  (StatefulGen g m) =>
+  Int -> g -> m (HashMap Bytes Int, HashMap Bytes Int)
+genBytesMapsOverlap s gen = do
+  (trues, falses) <- Key.Bytes.genDisjoint s bytesLength gen
+  let (a_sep, b_sep) = splitAt (s `div` 4) trues
+  return
+    ( keysToMap falses `HM.union` keysToMap a_sep,
+      keysToMap falses `HM.union` keysToMap b_sep
+    )
+
+genIntMapsOverlap ::
+  (StatefulGen g m) =>
+  Int -> g -> m (HashMap Int Int, HashMap Int Int)
+genIntMapsOverlap s gen = do
+  let s_overlap = s `div` 2
+  let s_a_sep = (s - s_overlap) `div` 2
+  let s_b_sep = s - s_overlap - s_a_sep
+  overlap <- genInts s_overlap gen
+  a_sep <- genInts s_a_sep gen
+  b_sep <- genInts s_b_sep gen
+  return
+    ( keysToMap overlap `HM.union` keysToMap a_sep,
+      keysToMap overlap `HM.union` keysToMap b_sep
+    )
 
 bUnionEqual :: [Benchmark]
 bUnionEqual =
-  [ bgroup "Bytes" [env' s setupBytes run | s <- defaultSizes],
-    bgroup "Int" [env' s setupInts run | s <- defaultSizes]
+  [ bgroup "Bytes" [env' s genBytesMap run | s <- defaultSizes],
+    bgroup "Int" [env' s genIntMap run | s <- defaultSizes]
   ]
   where
     run :: (Hashable a) => HashMap a Int -> Benchmarkable
     run = whnf (\m -> HM.union m m)
-    setupBytes s gen = do
-      ks <- Key.Bytes.genNBytes s bytesLength gen
-      return (keysToMap ks)
-    setupInts s gen = do
-      ks <- genInts s gen
-      return (keysToMap ks)
+
+genBytesMap :: (StatefulGen g m) => Int -> g -> m (HashMap Bytes Int)
+genBytesMap s gen = do
+  ks <- Key.Bytes.genNBytes s bytesLength gen
+  return (keysToMap ks)
+
+genIntMap :: (StatefulGen g m) => Int -> g -> m (HashMap Int Int)
+genIntMap s gen = do
+  ks <- genInts s gen
+  return (keysToMap ks)
 
 bDifference :: Benchmark
-bDifference = bgroup "difference" []
-{-
+bDifference =
+  bgroup
+    "difference"
     [ bgroup "disjoint" bDifferenceDisjoint,
       bgroup "overlap" bDifferenceOverlap,
       bgroup "equal" bDifferenceEqual
     ]
--}
 
 bDifferenceDisjoint :: [Benchmark]
-bDifferenceDisjoint = [ b "Bytes" setupBytes, b "Int" setupInts ]
+bDifferenceDisjoint =
+  [ bgroup' "Bytes" genBytesMapsDisjoint b,
+    bgroup' "Int" genIntMapsDisjoint b
+  ]
   where
-    b = undefined
-    setupBytes = undefined
-    setupInts = undefined
+    b size = bench (show size) . whnf (\(xs, ys) -> HM.difference xs ys)
+
+bgroup' ::
+  (NFData env) =>
+  String ->
+  (Int -> IOGenM StdGen -> IO env) ->
+  (Int -> env -> Benchmark) ->
+  Benchmark
+bgroup' name setup b = bgroup name [env'' setup b s | s <- defaultSizes]
 
 bDifferenceOverlap :: [Benchmark]
-bDifferenceOverlap = [ b "Bytes" setupBytes, b "Int" setupInts ]
+bDifferenceOverlap =
+  [ bgroup' "Bytes" genBytesMapsOverlap b,
+    bgroup' "Int" genIntMapsOverlap b
+  ]
   where
-    b = undefined
-    setupBytes = undefined
-    setupInts = undefined
+    b size = bench (show size) . whnf (\(xs, ys) -> HM.difference xs ys)
 
 bDifferenceEqual :: [Benchmark]
-bDifferenceEqual = [ b "Bytes" setupBytes, b "Int" setupInts ]
+bDifferenceEqual =
+  [ bgroup' "Bytes" genBytesMap b,
+    bgroup' "Int" genIntMap b
+  ]
   where
-    b = undefined
-    setupBytes = undefined
-    setupInts = undefined
-
+    b size = bench (show size) . whnf (\m -> HM.difference m m)
 
 bSetFromList :: Benchmark
 bSetFromList =