diff --git a/bench/Data/MessagePack/IntBench.hs b/bench/Data/MessagePack/IntBench.hs new file mode 100644 --- /dev/null +++ b/bench/Data/MessagePack/IntBench.hs @@ -0,0 +1,87 @@ +module Data.MessagePack.IntBench (suite) where + +import Criterion.Main (Benchmark, bench, bgroup, nf) +import qualified Data.ByteString.Lazy as LBS +import Data.Int (Int64) + +import Data.MessagePack + + +packInt :: Int64 -> LBS.ByteString +packInt = pack + +unpackInt :: LBS.ByteString -> Maybe Int64 +unpackInt = unpack + + +suite :: [Benchmark] +suite = + [ bgroup "pack" -- should be constant time + [ bench "0x1" $ nf packInt 0x1 + , bench "0x10" $ nf packInt 0x10 + , bench "0x100" $ nf packInt 0x100 + , bench "0x1000" $ nf packInt 0x1000 + , bench "0x10000" $ nf packInt 0x10000 + , bench "0x100000" $ nf packInt 0x100000 + , bench "0x1000000" $ nf packInt 0x1000000 + , bench "0x10000000" $ nf packInt 0x10000000 + , bench "0x100000000" $ nf packInt 0x100000000 + , bench "0x1000000000" $ nf packInt 0x1000000000 + , bench "0x10000000000" $ nf packInt 0x10000000000 + , bench "0x100000000000" $ nf packInt 0x100000000000 + , bench "0x1000000000000" $ nf packInt 0x1000000000000 + , bench "0x10000000000000" $ nf packInt 0x10000000000000 + , bench "0x100000000000000" $ nf packInt 0x100000000000000 + , bench "0x1000000000000000" $ nf packInt 0x1000000000000000 + , bench "-0x1" $ nf packInt (-0x1 ) + , bench "-0x10" $ nf packInt (-0x10 ) + , bench "-0x100" $ nf packInt (-0x100 ) + , bench "-0x1000" $ nf packInt (-0x1000 ) + , bench "-0x10000" $ nf packInt (-0x10000 ) + , bench "-0x100000" $ nf packInt (-0x100000 ) + , bench "-0x1000000" $ nf packInt (-0x1000000 ) + , bench "-0x10000000" $ nf packInt (-0x10000000 ) + , bench "-0x100000000" $ nf packInt (-0x100000000 ) + , bench "-0x1000000000" $ nf packInt (-0x1000000000 ) + , bench "-0x10000000000" $ nf packInt (-0x10000000000 ) + , bench "-0x100000000000" $ nf packInt (-0x100000000000 ) + , bench "-0x1000000000000" $ nf packInt (-0x1000000000000 ) + , bench "-0x10000000000000" $ nf packInt (-0x10000000000000 ) + , bench "-0x100000000000000" $ nf packInt (-0x100000000000000 ) + , bench "-0x1000000000000000" $ nf packInt (-0x1000000000000000) + ] + , bgroup "unpack" -- should be constant time + [ bench "0x1" $ nf unpackInt (packInt 0x1 ) + , bench "0x10" $ nf unpackInt (packInt 0x10 ) + , bench "0x100" $ nf unpackInt (packInt 0x100 ) + , bench "0x1000" $ nf unpackInt (packInt 0x1000 ) + , bench "0x10000" $ nf unpackInt (packInt 0x10000 ) + , bench "0x100000" $ nf unpackInt (packInt 0x100000 ) + , bench "0x1000000" $ nf unpackInt (packInt 0x1000000 ) + , bench "0x10000000" $ nf unpackInt (packInt 0x10000000 ) + , bench "0x100000000" $ nf unpackInt (packInt 0x100000000 ) + , bench "0x1000000000" $ nf unpackInt (packInt 0x1000000000 ) + , bench "0x10000000000" $ nf unpackInt (packInt 0x10000000000 ) + , bench "0x100000000000" $ nf unpackInt (packInt 0x100000000000 ) + , bench "0x1000000000000" $ nf unpackInt (packInt 0x1000000000000 ) + , bench "0x10000000000000" $ nf unpackInt (packInt 0x10000000000000 ) + , bench "0x100000000000000" $ nf unpackInt (packInt 0x100000000000000 ) + , bench "0x1000000000000000" $ nf unpackInt (packInt 0x1000000000000000 ) + , bench "-0x1" $ nf unpackInt (packInt (-0x1 )) + , bench "-0x10" $ nf unpackInt (packInt (-0x10 )) + , bench "-0x100" $ nf unpackInt (packInt (-0x100 )) + , bench "-0x1000" $ nf unpackInt (packInt (-0x1000 )) + , bench "-0x10000" $ nf unpackInt (packInt (-0x10000 )) + , bench "-0x100000" $ nf unpackInt (packInt (-0x100000 )) + , bench "-0x1000000" $ nf unpackInt (packInt (-0x1000000 )) + , bench "-0x10000000" $ nf unpackInt (packInt (-0x10000000 )) + , bench "-0x100000000" $ nf unpackInt (packInt (-0x100000000 )) + , bench "-0x1000000000" $ nf unpackInt (packInt (-0x1000000000 )) + , bench "-0x10000000000" $ nf unpackInt (packInt (-0x10000000000 )) + , bench "-0x100000000000" $ nf unpackInt (packInt (-0x100000000000 )) + , bench "-0x1000000000000" $ nf unpackInt (packInt (-0x1000000000000 )) + , bench "-0x10000000000000" $ nf unpackInt (packInt (-0x10000000000000 )) + , bench "-0x100000000000000" $ nf unpackInt (packInt (-0x100000000000000 )) + , bench "-0x1000000000000000" $ nf unpackInt (packInt (-0x1000000000000000)) + ] + ] diff --git a/bench/Data/MessagePackBench.hs b/bench/Data/MessagePackBench.hs new file mode 100644 --- /dev/null +++ b/bench/Data/MessagePackBench.hs @@ -0,0 +1,50 @@ +module Data.MessagePackBench (suite) where + +import Control.DeepSeq (NFData) +import Criterion.Main (Benchmark, bench, bgroup, nf) +import qualified Data.ByteString.Lazy as LBS +import Data.Int (Int64) +import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) +import Test.QuickCheck.Gen (resize, unGen) +import Test.QuickCheck.Random (mkQCGen) + +import Data.MessagePack + + +defaultSeed :: Int +defaultSeed = 301 + + +arb :: Arbitrary a => Int -> a +arb size = + let g = unGen $ resize size arbitrary in + g (mkQCGen defaultSeed) defaultSeed + + +benchRange + :: NFData b + => Int -> Int -> Int -> (a -> b) -> (Int -> a) -> [Benchmark] +benchRange from to steps f g = + map (\step -> + let sz = from + ((to - from) `div` (steps - 1)) * step in + bench (show sz) $ nf f (g sz) + ) [0..steps-1] + + +suite :: [Benchmark] +suite = + [ bgroup "pack" + [ bench "Just Int" $ nf pack (Just (3 :: Int)) + , bench "Nothing" $ nf pack (Nothing :: Maybe Int) + , bench "()" $ nf pack () + , bgroup "[a]" $ benchRange 1000 10000 10 pack (`replicate` ()) + -- ^ should be linear + ] + , bgroup "unpack" + [ bench "Just Int" $ nf (unpack :: LBS.ByteString -> Maybe Int) (pack (Just (3 :: Int))) + , bench "Nothing" $ nf (unpack :: LBS.ByteString -> Maybe Int) (pack (Nothing :: Maybe Int)) + , bench "()" $ nf (unpack :: LBS.ByteString -> Maybe () ) (pack ()) + , bgroup "[a]" $ benchRange 1000 10000 10 pack (`replicate` ()) + -- ^ should be linear + ] + ] diff --git a/data-msgpack.cabal b/data-msgpack.cabal --- a/data-msgpack.cabal +++ b/data-msgpack.cabal @@ -1,5 +1,5 @@ name: data-msgpack -version: 0.0.6 +version: 0.0.7 synopsis: A Haskell implementation of MessagePack homepage: http://msgpack.org/ license: BSD3 @@ -42,7 +42,7 @@ build-depends: base < 5 , QuickCheck - , binary + , binary >= 0.7.0.0 , bytestring , containers , data-binary-ieee754