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
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
|
{-# LANGUAGE CPP, OverloadedStrings, ExistentialQuantification, BangPatterns #-}
#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
#include "MachDeps.h"
#endif
module Main where
import Control.DeepSeq
import Control.Exception (evaluate)
import Control.Monad.Trans (liftIO)
import Criterion.Config
import Criterion.Main hiding (run)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Lazy as L
import Data.Char (ord)
import Data.Monoid (Monoid(mappend, mempty))
import Data.Word (Word8, Word16, Word32)
import Control.Applicative
import Data.Binary.Get
import Data.Binary ( get )
import qualified Data.Serialize.Get as Cereal
import qualified Data.Serialize as Cereal
import qualified Data.Attoparsec.ByteString as A
import qualified Data.Attoparsec.ByteString.Lazy as AL
#if !MIN_VERSION_bytestring(0,10,0)
instance NFData S.ByteString
instance NFData L.ByteString where
rnf = rnf . L.toChunks
#endif
main :: IO ()
main = do
evaluate $ rnf [
rnf brackets,
rnf bracketsInChunks,
rnf bracketCount,
rnf oneMegabyte,
rnf oneMegabyteLBS
]
defaultMain
[
bench "brackets 100kb one chunk input" $
whnf (checkBracket . runTest bracketParser) brackets
, bench "brackets 100kb in 100 byte chunks" $
whnf (checkBracket . runTest bracketParser) bracketsInChunks
, bench "Attoparsec lazy-bs brackets 100kb one chunk" $
whnf (checkBracket . runAttoL bracketParser_atto) brackets
, bench "Attoparsec lazy-bs brackets 100kb in 100 byte chunks" $
whnf (checkBracket . runAttoL bracketParser_atto) bracketsInChunks
, bench "Attoparsec strict-bs brackets 100kb" $
whnf (checkBracket . runAtto bracketParser_atto) $ S.concat (L.toChunks brackets)
, bench "Cereal strict-bs brackets 100kb" $
whnf (checkBracket . runCereal bracketParser_cereal) $ S.concat (L.toChunks brackets)
, bench "Binary getStruct4 1MB struct of 4 word8" $
whnf (runTest (getStruct4 mega)) oneMegabyteLBS
, bench "Cereal getStruct4 1MB struct of 4 word8" $
whnf (runCereal (getStruct4_cereal mega)) oneMegabyte
, bench "Attoparsec getStruct4 1MB struct of 4 word8" $
whnf (runAtto (getStruct4_atto mega)) oneMegabyte
, bench "Binary getWord8 1MB chunk size 1 byte" $
whnf (runTest (getWord8N1 mega)) oneMegabyteLBS
, bench "Cereal getWord8 1MB chunk size 1 byte" $
whnf (runCereal (getWord8N1_cereal mega)) oneMegabyte
, bench "Attoparsec getWord8 1MB chunk size 1 byte" $
whnf (runAtto (getWord8N1_atto mega)) oneMegabyte
, bench "getWord8 1MB chunk size 2 bytes" $
whnf (runTest (getWord8N2 mega)) oneMegabyteLBS
, bench "getWord8 1MB chunk size 4 bytes" $
whnf (runTest (getWord8N4 mega)) oneMegabyteLBS
, bench "getWord8 1MB chunk size 8 bytes" $
whnf (runTest (getWord8N8 mega)) oneMegabyteLBS
, bench "getWord8 1MB chunk size 16 bytes" $
whnf (runTest (getWord8N16 mega)) oneMegabyteLBS
, bench "getWord8 1MB chunk size 2 bytes Applicative" $
whnf (runTest (getWord8N2A mega)) oneMegabyteLBS
, bench "getWord8 1MB chunk size 4 bytes Applicative" $
whnf (runTest (getWord8N4A mega)) oneMegabyteLBS
, bench "getWord8 1MB chunk size 8 bytes Applicative" $
whnf (runTest (getWord8N8A mega)) oneMegabyteLBS
, bench "getWord8 1MB chunk size 16 bytes Applicative" $
whnf (runTest (getWord8N16A mega)) oneMegabyteLBS
]
checkBracket x | x == bracketCount = x
| otherwise = error "argh!"
runTest decoder inp = runGet decoder inp
runCereal decoder inp = case Cereal.runGet decoder inp of
Right a -> a
Left err -> error err
runAtto decoder inp = case A.parseOnly decoder inp of
Right a -> a
Left err -> error err
runAttoL decoder inp = case AL.parse decoder inp of
AL.Done _ r -> r
a -> error (show a)
-- Defs.
oneMegabyte :: S.ByteString
oneMegabyte = S.replicate mega $ fromIntegral $ ord 'a'
oneMegabyteLBS :: L.ByteString
oneMegabyteLBS = L.fromChunks [oneMegabyte]
mega = 1024 * 1024
-- 100k of brackets
bracketTest inp = runTest bracketParser inp
bracketCount :: Int
bracketCount = fromIntegral $ L.length brackets `div` 2
brackets = L.fromChunks [C8.concat (L.toChunks bracketsInChunks)]
bracketsInChunks = L.fromChunks (replicate chunksOfBrackets oneChunk)
where
oneChunk = "((()((()()))((()(()()()()()()()(((()()()()(()()(()(()())))))()((())())))()())(((())())(()))))()(()))"
chunksOfBrackets = 102400 `div` S.length oneChunk
bracketParser :: Get Int
bracketParser = cont <|> return 0
where
cont = do v <- some ( do 40 <- getWord8
n <- many cont
41 <- getWord8
return $! sum n + 1)
return $! sum v
bracketParser_cereal :: Cereal.Get Int
bracketParser_cereal = cont <|> return 0
where
cont = do v <- some ( do 40 <- Cereal.getWord8
n <- many cont
41 <- Cereal.getWord8
return $! sum n + 1)
return $! sum v
bracketParser_atto :: A.Parser Int
bracketParser_atto = cont <|> return 0
where
cont = do v <- some ( do A.word8 40
n <- bracketParser_atto
A.word8 41
return $! n + 1)
return $! sum v
-- Strict struct of 4 Word8s
data Struct4 = Struct4 {-# UNPACK #-} !Word8
{-# UNPACK #-} !Word8
{-# UNPACK #-} !Word8
{-# UNPACK #-} !Word8
deriving Show
getStruct4 = loop []
where loop acc 0 = return acc
loop acc n = do
!w0 <- getWord8
!w1 <- getWord8
!w2 <- getWord8
!w3 <- getWord8
let !s = Struct4 w0 w1 w2 w3
loop (s : acc) (n - 4)
getStruct4_cereal = loop []
where loop acc 0 = return acc
loop acc n = do
!w0 <- Cereal.getWord8
!w1 <- Cereal.getWord8
!w2 <- Cereal.getWord8
!w3 <- Cereal.getWord8
let !s = Struct4 w0 w1 w2 w3
loop (s : acc) (n - 4)
getStruct4_atto = loop []
where loop acc 0 = return acc
loop acc n = do
!w0 <- A.anyWord8
!w1 <- A.anyWord8
!w2 <- A.anyWord8
!w3 <- A.anyWord8
let !s = Struct4 w0 w1 w2 w3
loop (s : acc) (n - 4)
-- No-allocation loops.
getWord8N1 = loop 0
where loop s n | s `seq` n `seq` False = undefined
loop s 0 = return s
loop s n = do
s0 <- getWord8
loop (s0+s) (n-1)
getWord8N1_cereal = loop 0
where loop s n | s `seq` n `seq` False = undefined
loop s 0 = return s
loop s n = do
s0 <- Cereal.getWord8
loop (s0+s) (n-1)
getWord8N1_atto = loop 0
where loop s n | s `seq` n `seq` False = undefined
loop s 0 = return s
loop s n = do
s0 <- A.anyWord8
loop (s0+s) (n-1)
getWord8N2 = loop 0
where loop s n | s `seq` n `seq` False = undefined
loop s 0 = return s
loop s n = do
s0 <- getWord8
s1 <- getWord8
loop (s0+s1+s) (n-2)
getWord8N2A = loop 0
where loop s n | s `seq` n `seq` False = undefined
loop s 0 = return s
loop s n = do
v <- (+) <$> getWord8 <*> getWord8
loop (s+v) (n-2)
getWord8N4 = loop 0
where loop s n | s `seq` n `seq` False = undefined
loop s 0 = return s
loop s n = do
s0 <- getWord8
s1 <- getWord8
s2 <- getWord8
s3 <- getWord8
loop (s+s0+s1+s2+s3) (n-4)
getWord8N4A = loop 0
where loop s n | s `seq` n `seq` False = undefined
loop s 0 = return s
loop s n = do
let p !s0 !s1 !s2 !s3 = s0 + s1 + s2 + s3
v <- p <$> getWord8 <*> getWord8 <*> getWord8 <*> getWord8
loop (s+v) (n-4)
getWord8N8 = loop 0
where loop s n | s `seq` n `seq` False = undefined
loop s 0 = return s
loop s n = do
s0 <- getWord8
s1 <- getWord8
s2 <- getWord8
s3 <- getWord8
s4 <- getWord8
s5 <- getWord8
s6 <- getWord8
s7 <- getWord8
loop (s+s0+s1+s2+s3+s4+s5+s6+s7) (n-8)
getWord8N8A = loop 0
where loop s n | s `seq` n `seq` False = undefined
loop s 0 = return s
loop s n = do
let p !s0 !s1 !s2 !s3 !s4 !s5 !s6 !s7 =
s0 + s1 + s2 + s3 + s4 + s5 + s6 + s7
v <- p <$> getWord8
<*> getWord8
<*> getWord8
<*> getWord8
<*> getWord8
<*> getWord8
<*> getWord8
<*> getWord8
loop (s+v) (n-8)
getWord8N16 = loop 0
where loop s n | s `seq` n `seq` False = undefined
loop s 0 = return s
loop s n = do
s0 <- getWord8
s1 <- getWord8
s2 <- getWord8
s3 <- getWord8
s4 <- getWord8
s5 <- getWord8
s6 <- getWord8
s7 <- getWord8
s8 <- getWord8
s9 <- getWord8
s10 <- getWord8
s11 <- getWord8
s12 <- getWord8
s13 <- getWord8
s14 <- getWord8
s15 <- getWord8
loop (s+s0+s1+s2+s3+s4+s5+s6+s7+s8+s9+s10+s11+s12+s13+s14+s15) (n-16)
getWord8N16A = loop 0
where loop s n | s `seq` n `seq` False = undefined
loop s 0 = return s
loop s n = do
let p !s0 !s1 !s2 !s3 !s4 !s5 !s6 !s7 !s8 !s9 !s10 !s11 !s12 !s13 !s14 !s15 =
s0 + s1 + s2 + s3 + s4 + s5 + s6 + s7 + s8 + s9 + s10 + s11 + s12 + s13 + s14 + s15
!v <- p <$> getWord8
<*> getWord8
<*> getWord8
<*> getWord8
<*> getWord8
<*> getWord8
<*> getWord8
<*> getWord8
<*> getWord8
<*> getWord8
<*> getWord8
<*> getWord8
<*> getWord8
<*> getWord8
<*> getWord8
<*> getWord8
loop (s+v) (n-16)
|
