binary/benchmarks/Put.hs at 15d527fb96c0559a13b6fe6f26e4ad49333b3bd5 · konsumlamm/binary · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
{-# LANGUAGE DeriveGeneric #-}

import Control.DeepSeq
import Control.Exception (evaluate)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as L
import Data.Word
import Test.Tasty.Bench

import GHC.Generics

import Data.Binary
import Data.Binary.Put
import Data.ByteString.Builder as BB

main :: IO ()
main = do
  evaluate $ rnf
    [ rnf bigIntegers
    , rnf smallIntegers
    , rnf smallByteStrings
    , rnf smallStrings
    , rnf doubles
    , rnf word8s
    , rnf word16s
    , rnf word32s
    , rnf word64s
    ]
  defaultMain
    [ bench "small Integers" $ whnf (run . foldMap put) smallIntegers
    , bench "[small Integer]" $ whnf (run . put) smallIntegers

    , bench "big Integers" $ whnf (run . foldMap put) bigIntegers
    , bench "[big Integer]" $ whnf (run . put) bigIntegers

    , bench "small ByteStrings" $ whnf (run . foldMap put) smallByteStrings
    , bench "[small ByteString]" $ whnf (run . put) smallByteStrings

    , bench "small Strings" $ whnf (run . foldMap put) smallStrings
    , bench "[small String]" $ whnf (run . put) smallStrings

    , bench "Double" $ whnf (run . put) doubles

    , bench "Word8s monoid put" $ whnf (run . foldMap put) word8s
    , bench "Word8s builder" $ whnf (L.length . toLazyByteString . foldMap BB.word8) word8s
    , bench "[Word8]" $ whnf (run . put) word8s
    , bench "Word16s monoid put" $ whnf (run . foldMap put) word16s
    , bench "Word16s builder" $ whnf (L.length . toLazyByteString . foldMap BB.word16BE) word16s
    , bench "[Word16]" $ whnf (run . put) word16s
    , bench "Word32s monoid put" $ whnf (run . foldMap put) word32s
    , bench "Word32s builder" $ whnf (L.length . toLazyByteString . foldMap BB.word32BE) word32s
    , bench "[Word32]" $ whnf (run . put) word32s
    , bench "Word64s monoid put" $ whnf (run . foldMap put) word64s
    , bench "Word64s builder" $ whnf (L.length . toLazyByteString . foldMap BB.word64BE) word64s
    , bench "[Word64]" $ whnf (run . put) word64s

    , bgroup "Generics"
      [ bench "Struct monoid put" $ whnf (run . foldMap put) structs
      , bench "Struct put as list" $ whnf (run . put) structs
      , bench "StructList monoid put" $ whnf (run . foldMap put) structLists
      , bench "StructList put as list" $ whnf (run . put) structLists
      ]
    ]
  where
    run = L.length . runPut

data Struct = Struct Word8 Word16 Word32 Word64 deriving Generic
instance Binary Struct

data StructList = StructList [Struct] deriving Generic
instance Binary StructList

structs :: [Struct]
structs = take 10000 $ [ Struct a b 0 0 | a <- [0 .. maxBound], b <- [0 .. maxBound] ]

structLists :: [StructList]
structLists = replicate 1000 (StructList (take 10 structs))

-- Input data

smallIntegers :: [Integer]
smallIntegers = [0..10000]
{-# NOINLINE smallIntegers #-}

bigIntegers :: [Integer]
bigIntegers = [m .. m + 10000]
  where
    m :: Integer
    m = fromIntegral (maxBound :: Word64)
{-# NOINLINE bigIntegers #-}

smallByteStrings :: [S.ByteString]
smallByteStrings = replicate 10000 $ C.pack "abcdefghi"
{-# NOINLINE smallByteStrings #-}

smallStrings :: [String]
smallStrings = replicate 10000 "abcdefghi"
{-# NOINLINE smallStrings #-}

doubles :: [Double]
doubles = take 10000 $ [ sign * 2 ** n | sign <- [-1, 1], n <- [ 0, 0.2 .. 1023 ]]

word8s :: [Word8]
word8s = take 10000 $ cycle [minBound .. maxBound]
{-# NOINLINE word8s #-}

word16s :: [Word16]
word16s = take 10000 $ cycle [minBound .. maxBound]
{-# NOINLINE word16s #-}

word32s :: [Word32]
word32s = take 10000 $ cycle [minBound .. maxBound]
{-# NOINLINE word32s #-}

word64s :: [Word64]
word64s = take 10000 $ cycle [minBound .. maxBound]
{-# NOINLINE word64s #-}