git.iko.soy/text
on builder help sign in
text/tests/Benchmarks.hs
463 lines 18 kB history raw
1{-# LANGUAGE BangPatterns, GADTs, MagicHash #-}
3import qualified Data.ByteString.Char8 as BS
4import qualified Data.ByteString.Lazy.Char8 as BL
5import qualified Data.ByteString.Lazy.Internal as BL
6import Control.Monad.Trans (liftIO)
7import Control.Exception (evaluate)
8import Criterion.Main
9import Data.Char
10import Data.Monoid (mappend, mempty)
11import qualified Data.ByteString.UTF8 as UTF8
12import qualified Data.Text as TS
13import qualified Data.Text.IO as TS
14import qualified Data.Text.Lazy as TL
15import qualified Data.Text.Lazy.Builder as TB
16import qualified Data.Text.Lazy.IO as TL
17import qualified Data.List as L
18import qualified Data.Text.Encoding as TS
19import qualified Data.Text.Lazy.Encoding as TL
20import qualified Criterion.MultiMap as M
21import Control.DeepSeq
22import Criterion.Config
23import GHC.Base
26myConfig
27 | False = defaultConfig {
28 -- Always display an 800x600 window.
29 cfgPlot = M.singleton KernelDensity (Window 800 600)
30 }
31 | otherwise = defaultConfig
33instance NFData BS.ByteString
35instance NFData BL.ByteString where
36 rnf BL.Empty = ()
37 rnf (BL.Chunk _ ts) = rnf ts
39data B where
40 B :: NFData a => a -> B
42instance NFData B where
43 rnf (B b) = rnf b
45main = do
46 let dataFile = "text/test/russian.txt"
47 bsa <- BS.readFile dataFile
48 let tsa = TS.decodeUtf8 bsa
49 tsb = TS.toUpper tsa
50 tla = TL.fromChunks (TS.chunksOf 16376 tsa)
51 tlb = TL.fromChunks (TS.chunksOf 16376 tsb)
52 bsb = TS.encodeUtf8 tsb
53 bla = BL.fromChunks (chunksOf 16376 bsa)
54 blb = BL.fromChunks (chunksOf 16376 bsb)
55 bsa_len = BS.length bsa
56 tsa_len = TS.length tsa
57 bla_len = BL.length bla
58 tla_len = TL.length tla
59 la = UTF8.toString bsa
60 la_len = L.length la
61 tsb_len = TS.length tsb
62 lb = TS.unpack tsb
63 bsl = BS.lines bsa
64 bll = BL.lines bla
65 tsl = TS.lines tsa
66 tll = TL.lines tla
67 ll = L.lines la
68 defaultMainWith
69 myConfig
70 (liftIO . evaluate $
71 rnf [B tsa, B tsb, B tla, B tlb, B bsa, B bsb, B bla, B blb,
72 B bsa_len, B tsa_len, B bla_len, B tla_len, B la, B la_len,
73 B tsb_len, B lb, B bsl, B bll, B tsl, B tll, B ll])
74 [
75 bgroup "append" [
76 bench "ts" $ nf (TS.append tsb) tsa
77 , bench "tl" $ nf (TL.append tlb) tla
78 , bench "bs" $ nf (BS.append bsb) bsa
79 , bench "bl" $ nf (BL.append blb) bla
80 , bench "l" $ nf ((++) lb) la
81 ],
82 bgroup "concat" [
83 bench "ts" $ nf TS.concat tsl
84 , bench "tl" $ nf TL.concat tll
85 , bench "bs" $ nf BS.concat bsl
86 , bench "bl" $ nf BL.concat bll
87 , bench "l" $ nf L.concat ll
88 ],
89 bgroup "cons" [
90 bench "ts" $ nf (TS.cons c) tsa
91 , bench "tl" $ nf (TL.cons c) tla
92 , bench "bs" $ nf (BS.cons c) bsa
93 , bench "bl" $ nf (BL.cons c) bla
94 , bench "l" $ nf (c:) la
95 ],
96 bgroup "concatMap" [
97 bench "ts" $ nf (TS.concatMap (TS.replicate 3 . TS.singleton)) tsa
98 , bench "tl" $ nf (TL.concatMap (TL.replicate 3 . TL.singleton)) tla
99 , bench "bs" $ nf (BS.concatMap (BS.replicate 3)) bsa
100 , bench "bl" $ nf (BL.concatMap (BL.replicate 3)) bla
101 , bench "l" $ nf (L.concatMap (L.replicate 3 . (:[]))) la
102 ],
103 bgroup "decode" [
104 bench "ts" $ nf TS.decodeUtf8 bsa
105 , bench "tl" $ nf TL.decodeUtf8 bla
106 , bench "bs" $ nf BS.unpack bsa
107 , bench "bl" $ nf BL.unpack bla
108 , bench "l" $ nf UTF8.toString bsa
109 ],
110 bgroup "drop" [
111 bench "ts" $ nf (TS.drop (tsa_len `div` 3)) tsa
112 , bench "tl" $ nf (TL.drop (tla_len `div` 3)) tla
113 , bench "bs" $ nf (BS.drop (bsa_len `div` 3)) bsa
114 , bench "bl" $ nf (BL.drop (bla_len `div` 3)) bla
115 , bench "l" $ nf (L.drop (la_len `div` 3)) la
116 ],
117 bgroup "encode" [
118 bench "ts" $ nf TS.encodeUtf8 tsa
119 , bench "tl" $ nf TL.encodeUtf8 tla
120 , bench "bs" $ nf BS.pack la
121 , bench "bl" $ nf BL.pack la
122 , bench "l" $ nf UTF8.fromString la
123 ],
124 bgroup "filter" [
125 bench "ts" $ nf (TS.filter p0) tsa
126 , bench "tl" $ nf (TL.filter p0) tla
127 , bench "bs" $ nf (BS.filter p0) bsa
128 , bench "bl" $ nf (BL.filter p0) bla
129 , bench "l" $ nf (L.filter p0) la
130 ],
131 bgroup "filter.filter" [
132 bench "ts" $ nf (TS.filter p1 . TS.filter p0) tsa
133 , bench "tl" $ nf (TL.filter p1 . TL.filter p0) tla
134 , bench "bs" $ nf (BS.filter p1 . BS.filter p0) bsa
135 , bench "bl" $ nf (BL.filter p1 . BL.filter p0) bla
136 , bench "l" $ nf (L.filter p1 . L.filter p0) la
137 ],
138 bgroup "foldl'" [
139 bench "ts" $ nf (TS.foldl' len 0) tsa
140 , bench "tl" $ nf (TL.foldl' len 0) tla
141 , bench "bs" $ nf (BS.foldl' len 0) bsa
142 , bench "bl" $ nf (BL.foldl' len 0) bla
143 , bench "l" $ nf (L.foldl' len 0) la
144 ],
145 bgroup "foldr" [
146 bench "ts" $ nf (L.length . TS.foldr (:) []) tsa
147 , bench "tl" $ nf (L.length . TL.foldr (:) []) tla
148 , bench "bs" $ nf (L.length . BS.foldr (:) []) bsa
149 , bench "bl" $ nf (L.length . BL.foldr (:) []) bla
150 , bench "l" $ nf (L.length . L.foldr (:) []) la
151 ],
152 bgroup "head" [
153 bench "ts" $ nf TS.head tsa
154 , bench "tl" $ nf TL.head tla
155 , bench "bs" $ nf BS.head bsa
156 , bench "bl" $ nf BL.head bla
157 , bench "l" $ nf L.head la
158 ],
159 bgroup "init" [
160 bench "ts" $ nf TS.init tsa
161 , bench "tl" $ nf TL.init tla
162 , bench "bs" $ nf BS.init bsa
163 , bench "bl" $ nf BL.init bla
164 , bench "l" $ nf L.init la
165 ],
166 bgroup "intercalate" [
167 bench "ts" $ nf (TS.intercalate tsw) tsl
168 , bench "tl" $ nf (TL.intercalate tlw) tll
169 , bench "bs" $ nf (BS.intercalate bsw) bsl
170 , bench "bl" $ nf (BL.intercalate blw) bll
171 , bench "l" $ nf (L.intercalate lw) ll
172 ],
173 bgroup "intersperse" [
174 bench "ts" $ nf (TS.intersperse c) tsa
175 , bench "tl" $ nf (TL.intersperse c) tla
176 , bench "bs" $ nf (BS.intersperse c) bsa
177 , bench "bl" $ nf (BL.intersperse c) bla
178 , bench "l" $ nf (L.intersperse c) la
179 ],
180 bgroup "isInfixOf" [
181 bench "ts" $ nf (TS.isInfixOf tsw) tsa
182 , bench "tl" $ nf (TL.isInfixOf tlw) tla
183 , bench "bs" $ nf (BS.isInfixOf bsw) bsa
184 -- no isInfixOf for lazy bytestrings
185 , bench "l" $ nf (L.isInfixOf lw) la
186 ],
187 bgroup "last" [
188 bench "ts" $ nf TS.last tsa
189 , bench "tl" $ nf TL.last tla
190 , bench "bs" $ nf BS.last bsa
191 , bench "bl" $ nf BL.last bla
192 , bench "l" $ nf L.last la
193 ],
194 bgroup "map" [
195 bench "ts" $ nf (TS.map f) tsa
196 , bench "tl" $ nf (TL.map f) tla
197 , bench "bs" $ nf (BS.map f) bsa
198 , bench "bl" $ nf (BL.map f) bla
199 , bench "l" $ nf (L.map f) la
200 ],
201 bgroup "mapAccumL" [
202 bench "ts" $ nf (TS.mapAccumL g 0) tsa
203 , bench "tl" $ nf (TL.mapAccumL g 0) tla
204 , bench "bs" $ nf (BS.mapAccumL g 0) bsa
205 , bench "bl" $ nf (BL.mapAccumL g 0) bla
206 , bench "l" $ nf (L.mapAccumL g 0) la
207 ],
208 bgroup "mapAccumR" [
209 bench "ts" $ nf (TS.mapAccumR g 0) tsa
210 , bench "tl" $ nf (TL.mapAccumR g 0) tla
211 , bench "bs" $ nf (BS.mapAccumR g 0) bsa
212 , bench "bl" $ nf (BL.mapAccumR g 0) bla
213 , bench "l" $ nf (L.mapAccumR g 0) la
214 ],
215 bgroup "map.map" [
216 bench "ts" $ nf (TS.map f . TS.map f) tsa
217 , bench "tl" $ nf (TL.map f . TL.map f) tla
218 , bench "bs" $ nf (BS.map f . BS.map f) bsa
219 , bench "bl" $ nf (BL.map f . BL.map f) bla
220 , bench "l" $ nf (L.map f . L.map f) la
221 ],
222 bgroup "readFile" [
223 bench "ts" $ TS.readFile dataFile
224 , bench "tl" $ nfIO (TL.readFile dataFile)
225 , bench "bs" $ BS.readFile dataFile
226 , bench "bl" $ nfIO (BL.length `fmap` BL.readFile dataFile)
227 , bench "l" $ nfIO (length `fmap` readFile dataFile)
228 ],
229 bgroup "replicate char" [
230 bench "ts" $ nf (TS.replicate bsa_len) (TS.singleton c)
231 , bench "tl" $ nf (TL.replicate (fromIntegral bsa_len)) (TL.singleton c)
232 , bench "bs" $ nf (BS.replicate bsa_len) c
233 , bench "bl" $ nf (BL.replicate (fromIntegral bsa_len)) c
234 , bench "l" $ nf (L.replicate bsa_len) c
235 ],
236 bgroup "replicate string" [
237 bench "ts" $ nf (TS.replicate (bsa_len `div` TS.length tsw)) tsw
238 , bench "tl" $ nf (TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw
239 , bench "l" $ nf (replicat (bsa_len `div` TS.length tsw)) lw
240 ],
241 bgroup "reverse" [
242 bench "ts" $ nf TS.reverse tsa
243 , bench "tl" $ nf TL.reverse tla
244 , bench "bs" $ nf BS.reverse bsa
245 , bench "bl" $ nf BL.reverse bla
246 , bench "l" $ nf L.reverse la
247 ],
248 bgroup "take" [
249 bench "ts" $ nf (TS.take (tsa_len `div` 3)) tsa
250 , bench "tl" $ nf (TL.take (tla_len `div` 3)) tla
251 , bench "bs" $ nf (BS.take (bsa_len `div` 3)) bsa
252 , bench "bl" $ nf (BL.take (bla_len `div` 3)) bla
253 , bench "l" $ nf (L.take (la_len `div` 3)) la
254 ],
255 bgroup "tail" [
256 bench "ts" $ nf TS.tail tsa
257 , bench "tl" $ nf TL.tail tla
258 , bench "bs" $ nf BS.tail bsa
259 , bench "bl" $ nf BL.tail bla
260 , bench "l" $ nf L.tail la
261 ],
262 bgroup "toLower" [
263 bench "ts" $ nf TS.toLower tsa
264 , bench "tl" $ nf TL.toLower tla
265 , bench "bs" $ nf (BS.map toLower) bsa
266 , bench "bl" $ nf (BL.map toLower) bla
267 , bench "l" $ nf (L.map toLower) la
268 ],
269 bgroup "toUpper" [
270 bench "ts" $ nf TS.toUpper tsa
271 , bench "tl" $ nf TL.toUpper tla
272 , bench "bs" $ nf (BS.map toUpper) bsa
273 , bench "bl" $ nf (BL.map toUpper) bla
274 , bench "l" $ nf (L.map toUpper) la
275 ],
276 bgroup "words" [
277 bench "ts" $ nf TS.words tsa
278 , bench "tl" $ nf TL.words tla
279 , bench "bs" $ nf BS.words bsa
280 , bench "bl" $ nf BL.words bla
281 , bench "l" $ nf L.words la
282 ],
283 bgroup "zipWith" [
284 bench "ts" $ nf (TS.zipWith min tsb) tsa
285 , bench "tl" $ nf (TL.zipWith min tlb) tla
286 , bench "bs" $ nf (BS.zipWith min bsb) bsa
287 , bench "bl" $ nf (BL.zipWith min blb) bla
288 , bench "l" $ nf (L.zipWith min lb) la
289 ],
290 bgroup "length" [
291 bgroup "cons" [
292 bench "ts" $ nf (TS.length . TS.cons c) tsa
293 , bench "tl" $ nf (TL.length . TL.cons c) tla
294 , bench "bs" $ nf (BS.length . BS.cons c) bsa
295 , bench "bl" $ nf (BL.length . BL.cons c) bla
296 , bench "l" $ nf (L.length . (:) c) la
297 ],
298 bgroup "decode" [
299 bench "ts" $ nf (TS.length . TS.decodeUtf8) bsa
300 , bench "tl" $ nf (TL.length . TL.decodeUtf8) bla
301 , bench "bs" $ nf (L.length . BS.unpack) bsa
302 , bench "bl" $ nf (L.length . BL.unpack) bla
303 , bench "utf8-string" $ nf (L.length . UTF8.toString) bsa
304 ],
305 bgroup "drop" [
306 bench "ts" $ nf (TS.length . TS.drop (tsa_len `div` 3)) tsa
307 , bench "tl" $ nf (TL.length . TL.drop (tla_len `div` 3)) tla
308 , bench "bs" $ nf (BS.length . BS.drop (bsa_len `div` 3)) bsa
309 , bench "bl" $ nf (BL.length . BL.drop (bla_len `div` 3)) bla
310 , bench "l" $ nf (L.length . L.drop (la_len `div` 3)) la
311 ],
312 bgroup "filter" [
313 bench "ts" $ nf (TS.length . TS.filter p0) tsa
314 , bench "tl" $ nf (TL.length . TL.filter p0) tla
315 , bench "bs" $ nf (BS.length . BS.filter p0) bsa
316 , bench "bl" $ nf (BL.length . BL.filter p0) bla
317 , bench "l" $ nf (L.length . L.filter p0) la
318 ],
319 bgroup "filter.filter" [
320 bench "ts" $ nf (TS.length . TS.filter p1 . TS.filter p0) tsa
321 , bench "tl" $ nf (TL.length . TL.filter p1 . TL.filter p0) tla
322 , bench "bs" $ nf (BS.length . BS.filter p1 . BS.filter p0) bsa
323 , bench "bl" $ nf (BL.length . BL.filter p1 . BL.filter p0) bla
324 , bench "l" $ nf (L.length . L.filter p1 . L.filter p0) la
325 ],
326 bgroup "init" [
327 bench "ts" $ nf (TS.length . TS.init) tsa
328 , bench "tl" $ nf (TL.length . TL.init) tla
329 , bench "bs" $ nf (BS.length . BS.init) bsa
330 , bench "bl" $ nf (BL.length . BL.init) bla
331 , bench "l" $ nf (L.length . L.init) la
332 ],
333 bgroup "intercalate" [
334 bench "ts" $ nf (TS.length . TS.intercalate tsw) tsl
335 , bench "tl" $ nf (TL.length . TL.intercalate tlw) tll
336 , bench "bs" $ nf (BS.length . BS.intercalate bsw) bsl
337 , bench "bl" $ nf (BL.length . BL.intercalate blw) bll
338 , bench "l" $ nf (L.length . L.intercalate lw) ll
339 ],
340 bgroup "intersperse" [
341 bench "ts" $ nf (TS.length . TS.intersperse c) tsa
342 , bench "tl" $ nf (TL.length . TL.intersperse c) tla
343 , bench "bs" $ nf (BS.length . BS.intersperse c) bsa
344 , bench "bl" $ nf (BL.length . BL.intersperse c) bla
345 , bench "l" $ nf (L.length . L.intersperse c) la
346 ],
347 bgroup "map" [
348 bench "ts" $ nf (TS.length . TS.map f) tsa
349 , bench "tl" $ nf (TL.length . TL.map f) tla
350 , bench "bs" $ nf (BS.length . BS.map f) bsa
351 , bench "bl" $ nf (BL.length . BL.map f) bla
352 , bench "l" $ nf (L.length . L.map f) la
353 ],
354 bgroup "map.map" [
355 bench "ts" $ nf (TS.length . TS.map f . TS.map f) tsa
356 , bench "tl" $ nf (TL.length . TL.map f . TL.map f) tla
357 , bench "bs" $ nf (BS.length . BS.map f . BS.map f) bsa
358 , bench "l" $ nf (L.length . L.map f . L.map f) la
359 ],
360 bgroup "replicate char" [
361 bench "ts" $ nf (TS.length . TS.replicate bsa_len) (TS.singleton c)
362 , bench "tl" $ nf (TL.length . TL.replicate (fromIntegral bsa_len)) (TL.singleton c)
363 , bench "bs" $ nf (BS.length . BS.replicate bsa_len) c
364 , bench "bl" $ nf (BL.length . BL.replicate (fromIntegral bsa_len)) c
365 , bench "l" $ nf (L.length . L.replicate bsa_len) c
366 ],
367 bgroup "replicate string" [
368 bench "ts" $ nf (TS.length . TS.replicate (bsa_len `div` TS.length tsw)) tsw
369 , bench "tl" $ nf (TL.length . TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw
370 , bench "l" $ nf (L.length . replicat (bsa_len `div` TS.length tsw)) lw
371 ],
372 bgroup "take" [
373 bench "ts" $ nf (TS.length . TS.take (tsa_len `div` 3)) tsa
374 , bench "tl" $ nf (TL.length . TL.take (tla_len `div` 3)) tla
375 , bench "bs" $ nf (BS.length . BS.take (bsa_len `div` 3)) bsa
376 , bench "bl" $ nf (BL.length . BL.take (bla_len `div` 3)) bla
377 , bench "l" $ nf (L.length . L.take (la_len `div` 3)) la
378 ],
379 bgroup "tail" [
380 bench "ts" $ nf (TS.length . TS.tail) tsa
381 , bench "tl" $ nf (TL.length . TL.tail) tla
382 , bench "bs" $ nf (BS.length . BS.tail) bsa
383 , bench "bl" $ nf (BL.length . BL.tail) bla
384 , bench "l" $ nf (L.length . L.tail) la
385 ],
386 bgroup "toLower" [
387 bench "ts" $ nf (TS.length . TS.toLower) tsa
388 , bench "tl" $ nf (TL.length . TL.toLower) tla
389 , bench "bs" $ nf (BS.length . BS.map toLower) bsa
390 , bench "bl" $ nf (BL.length . BL.map toLower) bla
391 , bench "l" $ nf (L.length . L.map toLower) la
392 ],
393 bgroup "toUpper" [
394 bench "ts" $ nf (TS.length . TS.toUpper) tsa
395 , bench "tl" $ nf (TL.length . TL.toUpper) tla
396 , bench "bs" $ nf (BS.length . BS.map toUpper) bsa
397 , bench "bl" $ nf (BL.length . BL.map toUpper) bla
398 , bench "l" $ nf (L.length . L.map toUpper) la
399 ],
400 bgroup "words" [
401 bench "ts" $ nf (L.length . TS.words) tsa
402 , bench "tl" $ nf (L.length . TL.words) tla
403 , bench "bs" $ nf (L.length . BS.words) bsa
404 , bench "bl" $ nf (L.length . BL.words) bla
405 , bench "l" $ nf (L.length . L.words) la
406 ],
407 bgroup "zipWith" [
408 bench "ts" $ nf (TS.length . TS.zipWith min tsb) tsa
409 , bench "tl" $ nf (TL.length . TL.zipWith min tlb) tla
410 , bench "bs" $ nf (L.length . BS.zipWith min bsb) bsa
411 , bench "bl" $ nf (L.length . BL.zipWith min blb) bla
412 , bench "l" $ nf (L.length . L.zipWith min lb) la
413 ]
414 ],
415 bgroup "builder" [
416 bench "mappend char" $ nf (TL.length . TB.toLazyText . mappendNChar 'a') 10000,
417 bench "mappend 8 char" $ nf (TL.length . TB.toLazyText . mappend8Char) 'a',
418 bench "mappend text" $ nf (TL.length . TB.toLazyText . mappendNText short) 10000
419 ]
420 ]
421 where
422 c = 'й'
423 p0 = (== c)
424 p1 = (/= 'д')
425 lw = "право"
426 bsw = UTF8.fromString lw
427 blw = BL.fromChunks [bsw]
428 tsw = TS.pack lw
429 tlw = TL.fromChunks [tsw]
430 f (C# c#) = C# (chr# (ord# c# +# 1#))
431 g (I# i#) (C# c#) = (I# (i# +# 1#), C# (chr# (ord# c# +# i#)))
432 len l _ = l + (1::Int)
433 replicat n = concat . L.replicate n
434 short = TS.pack "short"
436chunksOf :: Int -> BS.ByteString -> [BS.ByteString]
437chunksOf k = go
438 where
439 go t = case BS.splitAt k t of
440 (a,b) | BS.null a -> []
441 | otherwise -> a : go b
443mappendNChar :: Char -> Int -> TB.Builder
444mappendNChar c n = go 0
445 where
446 go i
447 | i < n = TB.singleton c `mappend` go (i+1)
448 | otherwise = mempty
450-- Gives more opportunity for inlining and elimination of unnecesary
451-- bounds checks.
452mappend8Char :: Char -> TB.Builder
453mappend8Char c = TB.singleton c `mappend` TB.singleton c `mappend`
454 TB.singleton c `mappend` TB.singleton c `mappend`
455 TB.singleton c `mappend` TB.singleton c `mappend`
456 TB.singleton c `mappend` TB.singleton c
458mappendNText :: TS.Text -> Int -> TB.Builder
459mappendNText t n = go 0
460 where
461 go i
462 | i < n = TB.fromText t `mappend` go (i+1)
463 | otherwise = mempty