Tune to beat NewBinary
[packages/binary.git] / tests / Benchmark.hs
1 {-# OPTIONS -fbang-patterns #-}
2 module Main where
3
4 import qualified Data.ByteString.Lazy as L
5 import Data.Binary
6 import Data.Binary.Put
7 import Text.Printf
8
9 import Control.Exception
10 import System.CPUTime
11
12
13 main :: IO ()
14 main = do
15 word8
16 word16
17 word32
18 word64
19
20 time :: String -> IO a -> IO a
21 time label f = do
22 putStr (label ++ " ")
23 start <- getCPUTime
24 v <- f
25 end <- getCPUTime
26 let diff = (fromIntegral (end - start)) / (10^12)
27 printf "%0.4f\n" (diff :: Double)
28 return v
29
30 test label f n fs s = time label $ do
31 let bs = runPut (doN (n :: Int) fs s f)
32 evaluate (L.length bs)
33 return ()
34
35 doN :: Int -> (t2 -> t2) -> t2 -> (t2 -> Put) -> Put
36 doN 0 _ _ _ = return ()
37 doN !n !f !s !body = do
38 body s
39 doN (n-1) f (f s) body
40
41 word8 = test "Word8 10MB" putWord8 10000000 (+1) 0
42 word16 = test "Word16 10MB" putWord16be 5000000 (+1) 0
43 word32 = test "Word32 10MB" putWord32be 2500000 (+1) 0
44 word64 = test "Word64 10MB" putWord64be 1250000 (+1) 0
45