Add benchmarks for BlockQueue

bench/BenchMain.hs

@@ -8,6 +8,7 @@ import qualified Copar.Parser.BenchLexer
 import qualified Data.List.BenchUtils
 import qualified Copar.Algorithm.BenchInitialize
 import qualified Data.BenchRefinablePartition
+import qualified Data.BenchBlockQueue
 
 main :: IO ()
 main = defaultMain
@@ -17,4 +18,5 @@ main = defaultMain
   , Data.List.BenchUtils.benchmarks
   , Copar.Algorithm.BenchInitialize.benchmarks
   , Data.BenchRefinablePartition.benchmarks
+  , Data.BenchBlockQueue.benchmarks
   ]

bench/Data/BenchBlockQueue.hs

+{-# LANGUAGE FlexibleInstances #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Data.BenchBlockQueue (benchmarks) where
+
+import Prelude hiding (elem)
+
+import           Criterion
+
+import           Control.Monad.ST
+import           Control.Monad
+
+import           Control.DeepSeq
+
+import           Data.BlockQueue
+import           Data.Partition.Common          ( Block(..) )
+
+
+benchmarks :: Benchmark
+benchmarks = bgroup "Data.BlockQueue" [benchEnqueue, benchDequeue, benchElem]
+
+benchEnqueue :: Benchmark
+benchEnqueue = bgroup
+  "enqueue"
+  [ bench "10 blocks"
+    $ withInit (empty 100) (\q -> mapM_ (enqueue q . Block) [0 .. 9])
+  , bench "20 blocks"
+    $ withInit (empty 100) (\q -> mapM_ (enqueue q . Block) [0 .. 19])
+  , bench "30 blocks"
+    $ withInit (empty 100) (\q -> mapM_ (enqueue q . Block) [0 .. 29])
+  , bench "100 blocks"
+    $ withInit (empty 1000) (\q -> mapM_ (enqueue q . Block) [0 .. 99])
+  , bench "200 blocks"
+    $ withInit (empty 1000) (\q -> mapM_ (enqueue q . Block) [0 .. 199])
+  , bench "300 blocks"
+    $ withInit (empty 1000) (\q -> mapM_ (enqueue q . Block) [0 .. 299])
+  ]
+
+
+benchDequeue :: Benchmark
+benchDequeue = bgroup
+  "dequeue"
+  [ bench "10 blocks" $ withInit (create 10) (replicateM 10 . dequeue)
+  , bench "20 blocks" $ withInit (create 20) (replicateM 20 . dequeue)
+  , bench "30 blocks" $ withInit (create 30) (replicateM 30 . dequeue)
+  , bench "100 blocks" $ withInit (create 100) (replicateM 100 . dequeue)
+  , bench "200 blocks" $ withInit (create 200) (replicateM 200 . dequeue)
+  , bench "300 blocks" $ withInit (create 300) (replicateM 300 . dequeue)
+  ]
+
+benchElem :: Benchmark
+benchElem = bgroup "elem"
+  [ mkBench 10
+  , mkBench 20
+  , mkBench 30
+  , mkBench 100
+  , mkBench 200
+  , mkBench 300
+  ]
+
+  where
+    mkBench n = bench (show n ++ " blocks") $
+      withInit (create n) (\q -> mapM_ (`elem` q) [Block i | i <- [0..n-1]])
+
+instance NFData (BlockQueue RealWorld) where
+  rnf p = seq p ()
+
+create :: Int -> ST s (BlockQueue s)
+create n = do
+  q <- empty n
+  mapM_ (enqueue q . Block) [0..n-1]
+  return q
+
+withInit
+  :: NFData a
+  => ST RealWorld (BlockQueue RealWorld)
+  -> (BlockQueue RealWorld -> ST RealWorld a)
+  -> Benchmarkable
+withInit initialize action = perRunEnv (stToIO initialize) (stToIO . action)

copar.cabal

@@ -209,6 +209,7 @@ benchmark bench
                      , Data.List.BenchUtils
                      , Copar.Algorithm.BenchInitialize
                      , Data.BenchRefinablePartition
+                     , Data.BenchBlockQueue
   default-extensions:  GADTs
                      , StandaloneDeriving
                      , DeriveFunctor