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
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
#if !MIN_VERSION_base(4,8,0)
{-# LANGUAGE DeriveDataTypeable #-}
import Control.Applicative ((<$>), (<*>), (*>))
#endif
import Control.DeepSeq
import Criterion.Main
import qualified Data.ByteString as BS
import Data.Int
import qualified Data.IntMap.Strict as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Data.Store
import Data.Typeable
import qualified Data.Vector as V
import qualified Data.Vector.Storable as SV
import Data.Word
import GHC.Generics
#if COMPARISON_BENCH
import qualified Data.Binary as Binary
import qualified Data.Serialize as Cereal
import qualified Data.ByteString.Lazy as BL
import Data.Vector.Serialize ()
#endif
data SomeData = SomeData !Int64 !Word8 !Double
deriving (Eq, Show, Generic, Typeable)
instance NFData SomeData where
rnf x = x `seq` ()
instance Store SomeData
#if COMPARISON_BENCH
instance Cereal.Serialize SomeData
instance Binary.Binary SomeData
#endif
main :: IO ()
main = do
#if SMALL_BENCH
let is = 0::Int
sds = SomeData 1 1 1
smallprods = (SmallProduct 0 1 2 3)
smallmanualprods = (SmallProductManual 0 1 2 3)
sss = [SS1 1, SS2 2, SS3 3, SS4 4]
ssms = [SSM1 1, SSM2 2, SSM3 3, SSM4 4]
nestedTuples = ((1,2),(3,4)) :: ((Int,Int),(Int,Int))
#else
let is = V.enumFromTo 1 100 :: V.Vector Int
sds = (\i -> SomeData i (fromIntegral i) (fromIntegral i))
<$> V.enumFromTo 1 100
smallprods = (\ i -> SmallProduct i (i+1) (i+2) (i+3))
<$> V.enumFromTo 1 100
smallmanualprods = (\ i -> SmallProductManual i (i+1) (i+2) (i+3))
<$> V.enumFromTo 1 100
sss = (\i -> case i `mod` 4 of
0 -> SS1 (fromIntegral i)
1 -> SS2 (fromIntegral i)
2 -> SS3 (fromIntegral i)
3 -> SS4 (fromIntegral i)
_ -> error "This does not compute."
) <$> V.enumFromTo 1 (100 :: Int)
ssms = (\i -> case i `mod` 4 of
0 -> SSM1 (fromIntegral i)
1 -> SSM2 (fromIntegral i)
2 -> SSM3 (fromIntegral i)
3 -> SSM4 (fromIntegral i)
_ -> error "This does not compute."
) <$> V.enumFromTo 1 (100 :: Int)
nestedTuples = (\i -> ((i,i+1),(i+2,i+3))) <$> V.enumFromTo (1::Int) 100
ints = [1..100] :: [Int]
pairs = map (\x -> (x, x)) ints
strings = show <$> ints
intsSet = Set.fromDistinctAscList ints
intSet = IntSet.fromDistinctAscList ints
intsMap = Map.fromDistinctAscList pairs
intMap = IntMap.fromDistinctAscList pairs
stringsSet = Set.fromList strings
stringsMap = Map.fromList (zip strings ints)
#endif
defaultMain
[ bgroup "encode"
[ benchEncode is
#if !SMALL_BENCH
, benchEncode' "1kb storable" (SV.fromList ([1..256] :: [Int32]))
, benchEncode' "10kb storable" (SV.fromList ([1..(256 * 10)] :: [Int32]))
, benchEncode' "1kb normal" (V.fromList ([1..256] :: [Int32]))
, benchEncode' "10kb normal" (V.fromList ([1..(256 * 10)] :: [Int32]))
, benchEncode intsSet
, benchEncode intSet
, benchEncode intsMap
, benchEncode intMap
, benchEncode stringsSet
, benchEncode stringsMap
#endif
, benchEncode smallprods
, benchEncode smallmanualprods
, benchEncode sss
, benchEncode ssms
, benchEncode nestedTuples
, benchEncode sds
]
, bgroup "decode"
[ benchDecode is
#if !SMALL_BENCH
, benchDecode' "1kb storable" (SV.fromList ([1..256] :: [Int32]))
, benchDecode' "10kb storable" (SV.fromList ([1..(256 * 10)] :: [Int32]))
, benchDecode' "1kb normal" (V.fromList ([1..256] :: [Int32]))
, benchDecode' "10kb normal" (V.fromList ([1..(256 * 10)] :: [Int32]))
, benchDecode intsSet
, benchDecode intSet
, benchDecode intsMap
, benchDecode intMap
, benchDecode stringsSet
, benchDecode stringsMap
#endif
, benchDecode smallprods
, benchDecode smallmanualprods
, benchDecode sss
, benchDecode ssms
, benchDecode nestedTuples
, benchDecode sds
]
]
type Ctx a =
( Store a, Typeable a, NFData a
#if COMPARISON_BENCH
, Binary.Binary a
, Cereal.Serialize a
#endif
)
benchEncode :: Ctx a => a -> Benchmark
benchEncode = benchEncode' ""
benchEncode' :: Ctx a => String -> a -> Benchmark
benchEncode' msg x0 =
env (return x0) $ \x ->
let label = msg ++ " (" ++ show (typeOf x0) ++ ")"
benchStore name = bench name (nf encode x) in
#if COMPARISON_BENCH
bgroup label
[ benchStore "store"
, bench "cereal" (nf Cereal.encode x)
, bench "binary" (nf Binary.encode x)
]
#else
benchStore label
#endif
benchDecode :: Ctx a => a -> Benchmark
benchDecode = benchDecode' ""
benchDecode' :: forall a. Ctx a => String -> a -> Benchmark
#if COMPARISON_BENCH
benchDecode' prefix x0 =
bgroup label
[ env (return (encode x0)) $ \x -> bench "store" (nf (decodeEx :: BS.ByteString -> a) x)
, env (return (Cereal.encode x0)) $ \x -> bench "cereal" (nf ((ensureRight . Cereal.decode) :: BS.ByteString -> a) x)
, env (return (Binary.encode x0)) $ \x -> bench "binary" (nf (Binary.decode :: BL.ByteString -> a) x)
]
where
label = prefix ++ " (" ++ show (typeOf x0) ++ ")"
ensureRight (Left x) = error "left!"
ensureRight (Right x) = x
#else
benchDecode' prefix x0 =
env (return (encode x0)) $ \x ->
bench (prefix ++ " (" ++ show (typeOf x0) ++ ")") (nf (decodeEx :: BS.ByteString -> a) x)
#endif
------------------------------------------------------------------------
-- Serialized datatypes
data SmallProduct = SmallProduct Int32 Int32 Int32 Int32
deriving (Generic, Show, Typeable)
instance NFData SmallProduct
instance Store SmallProduct
data SmallProductManual = SmallProductManual Int32 Int32 Int32 Int32
deriving (Generic, Show, Typeable)
instance NFData SmallProductManual
instance Store SmallProductManual where
size = ConstSize 16
peek = SmallProductManual <$> peek <*> peek <*> peek <*> peek
poke (SmallProductManual a b c d) = poke a *> poke b *> poke c *> poke d
data SmallSum
= SS1 Int8
| SS2 Int32
| SS3 Int64
| SS4 Word32
deriving (Generic, Show, Typeable)
instance NFData SmallSum
instance Store SmallSum
data SmallSumManual
= SSM1 Int8
| SSM2 Int32
| SSM3 Int64
| SSM4 Word32
deriving (Generic, Show, Typeable)
instance NFData SmallSumManual
instance Store SmallSumManual where
size = VarSize $ \x -> 1 + case x of
SSM1{} -> 1
SSM2{} -> 4
SSM3{} -> 8
SSM4{} -> 4
peek = do
tag <- peek
case tag :: Word8 of
0 -> SSM1 <$> peek
1 -> SSM2 <$> peek
2 -> SSM3 <$> peek
3 -> SSM4 <$> peek
_ -> fail "Invalid tag"
poke (SSM1 x) = poke (0 :: Word8) >> poke x
poke (SSM2 x) = poke (1 :: Word8) >> poke x
poke (SSM3 x) = poke (2 :: Word8) >> poke x
poke (SSM4 x) = poke (3 :: Word8) >> poke x
#if COMPARISON_BENCH
instance Binary.Binary SmallProduct
instance Binary.Binary SmallSum
instance Cereal.Serialize SmallProduct
instance Cereal.Serialize SmallSum
instance Binary.Binary SmallProductManual where
get = SmallProductManual <$> Binary.get <*> Binary.get <*> Binary.get <*> Binary.get
put (SmallProductManual a b c d) = Binary.put a *> Binary.put b *> Binary.put c *> Binary.put d
instance Binary.Binary SmallSumManual where
get = do
tag <- Binary.get
case tag :: Word8 of
0 -> SSM1 <$> Binary.get
1 -> SSM2 <$> Binary.get
2 -> SSM3 <$> Binary.get
3 -> SSM4 <$> Binary.get
_ -> fail "Invalid tag"
put (SSM1 x) = Binary.put (0 :: Word8) *> Binary.put x
put (SSM2 x) = Binary.put (1 :: Word8) *> Binary.put x
put (SSM3 x) = Binary.put (2 :: Word8) *> Binary.put x
put (SSM4 x) = Binary.put (3 :: Word8) *> Binary.put x
instance Cereal.Serialize SmallProductManual where
get = SmallProductManual <$> Cereal.get <*> Cereal.get <*> Cereal.get <*> Cereal.get
put (SmallProductManual a b c d) = Cereal.put a *> Cereal.put b *> Cereal.put c *> Cereal.put d
instance Cereal.Serialize SmallSumManual where
get = do
tag <- Cereal.get
case tag :: Word8 of
0 -> SSM1 <$> Cereal.get
1 -> SSM2 <$> Cereal.get
2 -> SSM3 <$> Cereal.get
3 -> SSM4 <$> Cereal.get
_ -> fail "Invalid tag"
put (SSM1 x) = Cereal.put (0 :: Word8) *> Cereal.put x
put (SSM2 x) = Cereal.put (1 :: Word8) *> Cereal.put x
put (SSM3 x) = Cereal.put (2 :: Word8) *> Cereal.put x
put (SSM4 x) = Cereal.put (3 :: Word8) *> Cereal.put x
#endif
|
