bar

bench/macro/lsm-tree-bench-wp8.hs

@@ -38,7 +38,8 @@ I. The benchmark should be able to run in two modes, using the
 module Main (main) where
 
 import           Control.Applicative ((<**>))
-import           Control.Exception (bracket)
+import           Control.DeepSeq (force)
+import           Control.Exception (bracket, evaluate)
 import           Control.Monad (forM_, unless, void, when)
 import qualified Crypto.Hash.SHA256 as SHA256
 import qualified Data.Binary as B
@@ -229,15 +230,9 @@ doDryRun gopts opts = do
         else IS.empty
 
     void $ forFoldM_ initGen [ 0 .. opts.batchCount - 1 ] $ \b g -> do
-        -- how many keys there are
-        let maxK :: Word64
-            maxK = fromIntegral $ gopts.initialSize + opts.batchSize * b
-
         let lookups :: [Word64]
-            (!nextG, lookups) = mapAccumL (\g' _ -> swap (SM.bitmaskWithRejection64 maxK g')) g [1 .. opts.batchSize]
-
             inserts :: [Word64]
-            inserts = [ maxK .. maxK + fromIntegral opts.batchSize - 1 ]
+            (!nextG, lookups, inserts) = generateBatch gopts.initialSize opts.batchSize g b
 
         when opts.check $ do
             keys <- readIORef keysRef
@@ -249,15 +244,46 @@ doDryRun gopts opts = do
                 (IS.difference keys new)
                 (IS.fromList $ map fromIntegral inserts)
 
+        -- first batch is lookups
+        let batch1 :: [K]
+            batch1 = map makeKey lookups
+
+            batch2 :: [(K, LSM.Update V B)]
+            batch2 =
+                [ (k, LSM.Delete)
+                | k <- batch1
+                ] ++
+                [ (makeKey k, LSM.Insert theValue Nothing)
+                | k <- inserts
+                ]
+
+        evaluate $ force (batch1, batch2)
+
         return nextG
 
-{-
-implement generation of unbounded sequence of insert/delete operations
+
+{- | Implement generation of unbounded sequence of insert/delete operations
 
 matching UTxO style from spec: interleaved batches insert and lookup
 configurable batch sizes
 1 insert, 1 delete, 1 lookup per key.
 -}
+generateBatch
+    :: Int       -- ^ initial size of the collection
+    -> Int       -- ^ batch size
+    -> SM.SMGen  -- ^ generator
+    -> Int       -- ^ batch number
+    -> (SM.SMGen, [Word64], [Word64])
+generateBatch initialSize batchSize g b = (nextG, lookups, inserts)
+  where
+    maxK :: Word64
+    maxK = fromIntegral $ initialSize + batchSize * b
+
+    lookups :: [Word64]
+    (!nextG, lookups) = mapAccumL (\g' _ -> swap (SM.bitmaskWithRejection64 maxK g')) g [1 .. batchSize]
+
+    inserts :: [Word64]
+    inserts = [ maxK .. maxK + fromIntegral batchSize - 1 ]
 
 -------------------------------------------------------------------------------
 -- run
@@ -285,7 +311,7 @@ main = do
     prefs = O.prefs O.showHelpOnEmpty
 
 -------------------------------------------------------------------------------
--- utils
+-- utils: should this be in main lib?
 -------------------------------------------------------------------------------
 
 withSession :: FS.SomeHasFS IO -> FS.FsPath -> (LSM.Session IO -> IO r) -> IO r
@@ -299,7 +325,17 @@ defaultTableConfig =  LSM.TableConfig
     }
 
 -------------------------------------------------------------------------------
--- TODO
+-- general utils
+-------------------------------------------------------------------------------
+
+forFoldM_ :: Monad m => s -> [a] -> (a -> s -> m s) -> m s
+forFoldM_ !s []     _ = return s
+forFoldM_ !s (x:xs) f = do
+    !s' <- f x s
+    forFoldM_ s' xs f
+
+-------------------------------------------------------------------------------
+-- unused for now
 -------------------------------------------------------------------------------
 
 _unused :: ()
@@ -309,9 +345,3 @@ _unused = const ()
     , timed
     , timed_
     )
-
-forFoldM_ :: Monad m => s -> [a] -> (a -> s -> m s) -> m s
-forFoldM_ !s []     _ = return s
-forFoldM_ !s (x:xs) f = do
-    !s' <- f x s
-    forFoldM_ s' xs f

lsm-tree.cabal

@@ -351,6 +351,7 @@ benchmark lsm-tree-bench-wp8
     , clock
     , containers
     , cryptohash-sha256
+    , deepseq
     , fs-api
     , lsm-tree
     , optparse-applicative