Setup benchmarks for fromList with Bytes and Int keys

Author: sjakobi

benchmarks/FineGrained.hs

@@ -1,6 +1,96 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
+
 module Main where
 
+import Control.Monad (replicateM)
+import qualified Data.HashMap.Internal as HMI
+import qualified Data.HashMap.Strict as HM
+import Data.Hashable (Hashable, hash)
+import Key.Bytes
+import System.Random.Stateful
 import Test.Tasty.Bench
+import Prelude hiding (Foldable (..), lookup)
 
 main :: IO ()
-main = defaultMain []
+main =
+  defaultMain
+    [ bFromList
+    -- bgroup "insert" bInsert
+    -- union
+    ]
+
+defaultGen :: StdGen
+defaultGen = mkStdGen 42
+
+defaultSizes :: [Int]
+defaultSizes = [0, 1, 10, 100, 1000, 10_000, 100_000]
+
+{-
+bInsert = [ env m $ \d -> bench (show s) $ whnf (\(k, v, m) -> HM.insert k v m) d ]
+  where m s = do
+          g <- newIOGenM defaultGen
+          let hm = HM.empty
+          forM_ [1..s] $ \v -> do
+            b <- genBytes 32 g
+            HMI.unsafeInsert b v hm
+          return (m, newKeys) -- separate existing, new
+-}
+
+{-
+matrix :: (NFData env) => [Int] -> (Int -> IO env) -> (env -> Benchmarkable) -> Benchmark
+matrix sizes e x = b -- [ b @Bytes, b @Int] -- , b @SlowInt, b @Colli ]
+  where
+    b = bgroup "bla" [runTemplate @Int e x s | s <- sizes]
+
+runTemplate :: forall env. (NFData env) => (Int -> IO env) -> (env -> Benchmarkable) -> Int -> Benchmark
+runTemplate e b s = env (e s) $ \x -> bench (show s) (b x)
+-}
+
+bFromList :: Benchmark
+bFromList =
+  bgroup
+    "fromList"
+    [ bgroup
+        "Bytes"
+        [ env
+            ( do
+                g <- newIOGenM defaultGen
+                genNBytes s 32 g
+            )
+            $ \keys ->
+              bench (show s) $ whnf (HM.fromList . map (, ())) keys
+        | s <- sizes
+        ],
+      bgroup
+        "Int"
+        [ env
+            ( do
+                g <- newIOGenM defaultGen
+                genInts s g
+            )
+            $ \keys -> bench (show s) $ whnf (HM.fromList . map (,())) keys
+        | s <- sizes
+        ]
+    ]
+  where
+    sizes = defaultSizes
+
+genInts ::
+  (StatefulGen g m) =>
+  Int ->
+  g ->
+  m [Int]
+genInts n = do
+  replicateM n . uniformM
+
+{-
+bFromList = matrix defaultSizes e' b'
+  where
+    e' s = uniformListM s defaultGen
+    b' = whnf HM.fromList
+-}

benchmarks/Key/Bytes.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Key.Bytes where
+
+import Control.Monad (replicateM)
+import Data.ByteString.Short
+import Data.Hashable
+import System.Random.Stateful
+import Control.DeepSeq
+
+newtype Bytes = Bytes {unBytes :: ShortByteString}
+  deriving (Eq, Hashable, Show, NFData)
+
+genBytes ::
+  (StatefulGen g m) =>
+  Int ->
+  g ->
+  m Bytes
+genBytes len gen = Bytes <$> uniformShortByteStringM len gen
+
+genNBytes ::
+  (StatefulGen g m) =>
+  Int ->
+  Int ->
+  g ->
+  m [Bytes]
+genNBytes n len = replicateM n . genBytes len
+
+instance Uniform Bytes where
+  uniformM = genBytes 32 

unordered-containers.cabal

@@ -142,10 +142,14 @@ benchmark fine-grained
   type: exitcode-stdio-1.0
 
   other-modules:
+    Key.Bytes
 
   build-depends:
     base,
+    bytestring,
+    deepseq,
     hashable,
+    random,
     tasty-bench,
     unordered-containers