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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
{-# LANGUAGE CPP, ExistentialQuantification #-}
{-# LANGUAGE DeriveGeneric #-}
module Main (main) where
import Control.DeepSeq
import Control.Exception (evaluate)
import Criterion.Main
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as L
import Data.Monoid
import GHC.Generics
import Data.Binary
import Data.Binary.Put
import Data.ByteString.Builder as BB
import Prelude -- Silence Monoid import warning.
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 . fromIntegers) smallIntegers,
bench "big Integers" $ whnf (run . fromIntegers) bigIntegers,
bench "[small Integer]" $ whnf (run . put) smallIntegers,
bench "[big Integer]" $ whnf (run . put) bigIntegers,
bench "small ByteStrings" $ whnf (run . fromByteStrings) smallByteStrings,
bench "[small ByteString]" $ whnf (run . put) smallByteStrings,
bench "small Strings" $ whnf (run . fromStrings) smallStrings,
bench "[small String]" $ whnf (run . put) smallStrings,
bench "Double" $ whnf (run . put) doubles,
bench "Word8s monoid put" $ whnf (run . fromWord8s) word8s,
bench "Word8s builder" $ whnf (L.length . toLazyByteString . fromWord8sBuilder) word8s,
bench "[Word8]" $ whnf (run . put) word8s,
bench "Word16s monoid put" $ whnf (run . fromWord16s) word16s,
bench "Word16s builder" $ whnf (L.length . toLazyByteString . fromWord16sBuilder) word16s,
bench "[Word16]" $ whnf (run . put) word16s,
bench "Word32s monoid put" $ whnf (run . fromWord32s) word32s,
bench "Word32s builder" $ whnf (L.length . toLazyByteString . fromWord32sBuilder) word32s,
bench "[Word32]" $ whnf (run . put) word32s,
bench "Word64s monoid put" $ whnf (run . fromWord64s) word64s,
bench "Word64s builder" $ whnf (L.length . toLazyByteString . fromWord64sBuilder) word64s,
bench "[Word64]" $ whnf (run . put) word64s
, bgroup "Generics" [
bench "Struct monoid put" $ whnf (run . fromStructs) structs,
bench "Struct put as list" $ whnf (run . put) structs,
bench "StructList monoid put" $ whnf (run . fromStructLists) 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 #-}
------------------------------------------------------------------------
-- Benchmarks
fromIntegers :: [Integer] -> Put
fromIntegers [] = mempty
fromIntegers (x:xs) = put x `mappend` fromIntegers xs
fromByteStrings :: [S.ByteString] -> Put
fromByteStrings [] = mempty
fromByteStrings (x:xs) = put x `mappend` fromByteStrings xs
fromStrings :: [String] -> Put
fromStrings [] = mempty
fromStrings (x:xs) = put x `mappend` fromStrings xs
fromWord8s :: [Word8] -> Put
fromWord8s [] = mempty
fromWord8s (x:xs) = put x `mappend` fromWord8s xs
fromWord8sBuilder :: [Word8] -> BB.Builder
fromWord8sBuilder [] = mempty
fromWord8sBuilder (x:xs) = BB.word8 x `mappend` fromWord8sBuilder xs
fromWord16s :: [Word16] -> Put
fromWord16s [] = mempty
fromWord16s (x:xs) = put x `mappend` fromWord16s xs
fromWord16sBuilder :: [Word16] -> BB.Builder
fromWord16sBuilder [] = mempty
fromWord16sBuilder (x:xs) = BB.word16BE x `mappend` fromWord16sBuilder xs
fromWord32s :: [Word32] -> Put
fromWord32s [] = mempty
fromWord32s (x:xs) = put x `mappend` fromWord32s xs
fromWord32sBuilder :: [Word32] -> BB.Builder
fromWord32sBuilder [] = mempty
fromWord32sBuilder (x:xs) = BB.word32BE x `mappend` fromWord32sBuilder xs
fromWord64s :: [Word64] -> Put
fromWord64s [] = mempty
fromWord64s (x:xs) = put x `mappend` fromWord64s xs
fromWord64sBuilder :: [Word64] -> BB.Builder
fromWord64sBuilder [] = mempty
fromWord64sBuilder (x:xs) = BB.word64BE x `mappend` fromWord64sBuilder xs
fromStructs :: [Struct] -> Put
fromStructs [] = mempty
fromStructs (x:xs) = put x `mappend` fromStructs xs
fromStructLists :: [StructList] -> Put
fromStructLists [] = mempty
fromStructLists (x:xs) = put x `mappend` fromStructLists xs
|
