git.iko.soy/text
on 47be150 help sign in
text/tests/Benchmarks.hs
441 lines 17 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 Codec.Binary.UTF8.Generic 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 "filter" [
118 bench "ts" $ nf (TS.filter p0) tsa
119 , bench "tl" $ nf (TL.filter p0) tla
120 , bench "bs" $ nf (BS.filter p0) bsa
121 , bench "bl" $ nf (BL.filter p0) bla
122 , bench "l" $ nf (L.filter p0) la
123 ],
124 bgroup "filter.filter" [
125 bench "ts" $ nf (TS.filter p1 . TS.filter p0) tsa
126 , bench "tl" $ nf (TL.filter p1 . TL.filter p0) tla
127 , bench "bs" $ nf (BS.filter p1 . BS.filter p0) bsa
128 , bench "bl" $ nf (BL.filter p1 . BL.filter p0) bla
129 , bench "l" $ nf (L.filter p1 . L.filter p0) la
130 ],
131 bgroup "foldl'" [
132 bench "ts" $ nf (TS.foldl' len 0) tsa
133 , bench "tl" $ nf (TL.foldl' len 0) tla
134 , bench "bs" $ nf (BS.foldl' len 0) bsa
135 , bench "bl" $ nf (BL.foldl' len 0) bla
136 , bench "l" $ nf (L.foldl' len 0) la
137 ],
138 bgroup "foldr" [
139 bench "ts" $ nf (L.length . TS.foldr (:) []) tsa
140 , bench "tl" $ nf (L.length . TL.foldr (:) []) tla
141 , bench "bs" $ nf (L.length . BS.foldr (:) []) bsa
142 , bench "bl" $ nf (L.length . BL.foldr (:) []) bla
143 , bench "l" $ nf (L.length . L.foldr (:) []) la
144 ],
145 bgroup "head" [
146 bench "ts" $ nf TS.head tsa
147 , bench "tl" $ nf TL.head tla
148 , bench "bs" $ nf BS.head bsa
149 , bench "bl" $ nf BL.head bla
150 , bench "l" $ nf L.head la
151 ],
152 bgroup "init" [
153 bench "ts" $ nf TS.init tsa
154 , bench "tl" $ nf TL.init tla
155 , bench "bs" $ nf BS.init bsa
156 , bench "bl" $ nf BL.init bla
157 , bench "l" $ nf L.init la
158 ],
159 bgroup "intercalate" [
160 bench "ts" $ nf (TS.intercalate tsw) tsl
161 , bench "tl" $ nf (TL.intercalate tlw) tll
162 , bench "bs" $ nf (BS.intercalate bsw) bsl
163 , bench "bl" $ nf (BL.intercalate blw) bll
164 , bench "l" $ nf (L.intercalate lw) ll
165 ],
166 bgroup "intersperse" [
167 bench "ts" $ nf (TS.intersperse c) tsa
168 , bench "tl" $ nf (TL.intersperse c) tla
169 , bench "bs" $ nf (BS.intersperse c) bsa
170 , bench "bl" $ nf (BL.intersperse c) bla
171 , bench "l" $ nf (L.intersperse c) la
172 ],
173 bgroup "isInfixOf" [
174 bench "ts" $ nf (TS.isInfixOf tsw) tsa
175 , bench "tl" $ nf (TL.isInfixOf tlw) tla
176 , bench "bs" $ nf (BS.isInfixOf bsw) bsa
177 -- no isInfixOf for lazy bytestrings
178 , bench "l" $ nf (L.isInfixOf lw) la
179 ],
180 bgroup "last" [
181 bench "ts" $ nf TS.last tsa
182 , bench "tl" $ nf TL.last tla
183 , bench "bs" $ nf BS.last bsa
184 , bench "bl" $ nf BL.last bla
185 , bench "l" $ nf L.last la
186 ],
187 bgroup "map" [
188 bench "ts" $ nf (TS.map f) tsa
189 , bench "tl" $ nf (TL.map f) tla
190 , bench "bs" $ nf (BS.map f) bsa
191 , bench "bl" $ nf (BL.map f) bla
192 , bench "l" $ nf (L.map f) la
193 ],
194 bgroup "map.map" [
195 bench "ts" $ nf (TS.map f . TS.map f) tsa
196 , bench "tl" $ nf (TL.map f . TL.map f) tla
197 , bench "bs" $ nf (BS.map f . BS.map f) bsa
198 , bench "bl" $ nf (BL.map f . BL.map f) bla
199 , bench "l" $ nf (L.map f . L.map f) la
200 ],
201 bgroup "readFile" [
202 bench "ts" $ TS.readFile dataFile
203 , bench "tl" $ nfIO (TL.readFile dataFile)
204 , bench "bs" $ BS.readFile dataFile
205 , bench "bl" $ nfIO (BL.length `fmap` BL.readFile dataFile)
206 , bench "l" $ nfIO (length `fmap` readFile dataFile)
207 ],
208 bgroup "replicate char" [
209 bench "ts" $ nf (TS.replicate bsa_len) (TS.singleton c)
210 , bench "tl" $ nf (TL.replicate (fromIntegral bsa_len)) (TL.singleton c)
211 , bench "bs" $ nf (BS.replicate bsa_len) c
212 , bench "bl" $ nf (BL.replicate (fromIntegral bsa_len)) c
213 , bench "l" $ nf (L.replicate bsa_len) c
214 ],
215 bgroup "replicate string" [
216 bench "ts" $ nf (TS.replicate (bsa_len `div` TS.length tsw)) tsw
217 , bench "tl" $ nf (TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw
218 , bench "l" $ nf (replicat (bsa_len `div` TS.length tsw)) lw
219 ],
220 bgroup "reverse" [
221 bench "ts" $ nf TS.reverse tsa
222 , bench "tl" $ nf TL.reverse tla
223 , bench "bs" $ nf BS.reverse bsa
224 , bench "bl" $ nf BL.reverse bla
225 , bench "l" $ nf L.reverse la
226 ],
227 bgroup "take" [
228 bench "ts" $ nf (TS.take (tsa_len `div` 3)) tsa
229 , bench "tl" $ nf (TL.take (tla_len `div` 3)) tla
230 , bench "bs" $ nf (BS.take (bsa_len `div` 3)) bsa
231 , bench "bl" $ nf (BL.take (bla_len `div` 3)) bla
232 , bench "l" $ nf (L.take (la_len `div` 3)) la
233 ],
234 bgroup "tail" [
235 bench "ts" $ nf TS.tail tsa
236 , bench "tl" $ nf TL.tail tla
237 , bench "bs" $ nf BS.tail bsa
238 , bench "bl" $ nf BL.tail bla
239 , bench "l" $ nf L.tail la
240 ],
241 bgroup "toLower" [
242 bench "ts" $ nf TS.toLower tsa
243 , bench "tl" $ nf TL.toLower tla
244 , bench "bs" $ nf (BS.map toLower) bsa
245 , bench "bl" $ nf (BL.map toLower) bla
246 , bench "l" $ nf (L.map toLower) la
247 ],
248 bgroup "toUpper" [
249 bench "ts" $ nf TS.toUpper tsa
250 , bench "tl" $ nf TL.toUpper tla
251 , bench "bs" $ nf (BS.map toUpper) bsa
252 , bench "bl" $ nf (BL.map toUpper) bla
253 , bench "l" $ nf (L.map toUpper) la
254 ],
255 bgroup "words" [
256 bench "ts" $ nf TS.words tsa
257 , bench "tl" $ nf TL.words tla
258 , bench "bs" $ nf BS.words bsa
259 , bench "bl" $ nf BL.words bla
260 , bench "l" $ nf L.words la
261 ],
262 bgroup "zipWith" [
263 bench "ts" $ nf (TS.zipWith min tsb) tsa
264 , bench "tl" $ nf (TL.zipWith min tlb) tla
265 , bench "bs" $ nf (BS.zipWith min bsb) bsa
266 , bench "bl" $ nf (BL.zipWith min blb) bla
267 , bench "l" $ nf (L.zipWith min lb) la
268 ],
269 bgroup "length" [
270 bgroup "cons" [
271 bench "ts" $ nf (TS.length . TS.cons c) tsa
272 , bench "tl" $ nf (TL.length . TL.cons c) tla
273 , bench "bs" $ nf (BS.length . BS.cons c) bsa
274 , bench "bl" $ nf (BL.length . BL.cons c) bla
275 , bench "l" $ nf (L.length . (:) c) la
276 ],
277 bgroup "decode" [
278 bench "ts" $ nf (TS.length . TS.decodeUtf8) bsa
279 , bench "tl" $ nf (TL.length . TL.decodeUtf8) bla
280 , bench "bs" $ nf (L.length . BS.unpack) bsa
281 , bench "bl" $ nf (L.length . BL.unpack) bla
282 , bench "utf8-string" $ nf (L.length . UTF8.toString) bsa
283 ],
284 bgroup "drop" [
285 bench "ts" $ nf (TS.length . TS.drop (tsa_len `div` 3)) tsa
286 , bench "tl" $ nf (TL.length . TL.drop (tla_len `div` 3)) tla
287 , bench "bs" $ nf (BS.length . BS.drop (bsa_len `div` 3)) bsa
288 , bench "bl" $ nf (BL.length . BL.drop (bla_len `div` 3)) bla
289 , bench "l" $ nf (L.length . L.drop (la_len `div` 3)) la
290 ],
291 bgroup "filter" [
292 bench "ts" $ nf (TS.length . TS.filter p0) tsa
293 , bench "tl" $ nf (TL.length . TL.filter p0) tla
294 , bench "bs" $ nf (BS.length . BS.filter p0) bsa
295 , bench "bl" $ nf (BL.length . BL.filter p0) bla
296 , bench "l" $ nf (L.length . L.filter p0) la
297 ],
298 bgroup "filter.filter" [
299 bench "ts" $ nf (TS.length . TS.filter p1 . TS.filter p0) tsa
300 , bench "tl" $ nf (TL.length . TL.filter p1 . TL.filter p0) tla
301 , bench "bs" $ nf (BS.length . BS.filter p1 . BS.filter p0) bsa
302 , bench "bl" $ nf (BL.length . BL.filter p1 . BL.filter p0) bla
303 , bench "l" $ nf (L.length . L.filter p1 . L.filter p0) la
304 ],
305 bgroup "init" [
306 bench "ts" $ nf (TS.length . TS.init) tsa
307 , bench "tl" $ nf (TL.length . TL.init) tla
308 , bench "bs" $ nf (BS.length . BS.init) bsa
309 , bench "bl" $ nf (BL.length . BL.init) bla
310 , bench "l" $ nf (L.length . L.init) la
311 ],
312 bgroup "intercalate" [
313 bench "ts" $ nf (TS.length . TS.intercalate tsw) tsl
314 , bench "tl" $ nf (TL.length . TL.intercalate tlw) tll
315 , bench "bs" $ nf (BS.length . BS.intercalate bsw) bsl
316 , bench "bl" $ nf (BL.length . BL.intercalate blw) bll
317 , bench "l" $ nf (L.length . L.intercalate lw) ll
318 ],
319 bgroup "intersperse" [
320 bench "ts" $ nf (TS.length . TS.intersperse c) tsa
321 , bench "tl" $ nf (TL.length . TL.intersperse c) tla
322 , bench "bs" $ nf (BS.length . BS.intersperse c) bsa
323 , bench "bl" $ nf (BL.length . BL.intersperse c) bla
324 , bench "l" $ nf (L.length . L.intersperse c) la
325 ],
326 bgroup "map" [
327 bench "ts" $ nf (TS.length . TS.map f) tsa
328 , bench "tl" $ nf (TL.length . TL.map f) tla
329 , bench "bs" $ nf (BS.length . BS.map f) bsa
330 , bench "bl" $ nf (BL.length . BL.map f) bla
331 , bench "l" $ nf (L.length . L.map f) la
332 ],
333 bgroup "map.map" [
334 bench "ts" $ nf (TS.length . TS.map f . TS.map f) tsa
335 , bench "tl" $ nf (TL.length . TL.map f . TL.map f) tla
336 , bench "bs" $ nf (BS.length . BS.map f . BS.map f) bsa
337 , bench "l" $ nf (L.length . L.map f . L.map f) la
338 ],
339 bgroup "replicate char" [
340 bench "ts" $ nf (TS.length . TS.replicate bsa_len) (TS.singleton c)
341 , bench "tl" $ nf (TL.length . TL.replicate (fromIntegral bsa_len)) (TL.singleton c)
342 , bench "bs" $ nf (BS.length . BS.replicate bsa_len) c
343 , bench "bl" $ nf (BL.length . BL.replicate (fromIntegral bsa_len)) c
344 , bench "l" $ nf (L.length . L.replicate bsa_len) c
345 ],
346 bgroup "replicate string" [
347 bench "ts" $ nf (TS.length . TS.replicate (bsa_len `div` TS.length tsw)) tsw
348 , bench "tl" $ nf (TL.length . TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw
349 , bench "l" $ nf (L.length . replicat (bsa_len `div` TS.length tsw)) lw
350 ],
351 bgroup "take" [
352 bench "ts" $ nf (TS.length . TS.take (tsa_len `div` 3)) tsa
353 , bench "tl" $ nf (TL.length . TL.take (tla_len `div` 3)) tla
354 , bench "bs" $ nf (BS.length . BS.take (bsa_len `div` 3)) bsa
355 , bench "bl" $ nf (BL.length . BL.take (bla_len `div` 3)) bla
356 , bench "l" $ nf (L.length . L.take (la_len `div` 3)) la
357 ],
358 bgroup "tail" [
359 bench "ts" $ nf (TS.length . TS.tail) tsa
360 , bench "tl" $ nf (TL.length . TL.tail) tla
361 , bench "bs" $ nf (BS.length . BS.tail) bsa
362 , bench "bl" $ nf (BL.length . BL.tail) bla
363 , bench "l" $ nf (L.length . L.tail) la
364 ],
365 bgroup "toLower" [
366 bench "ts" $ nf (TS.length . TS.toLower) tsa
367 , bench "tl" $ nf (TL.length . TL.toLower) tla
368 , bench "bs" $ nf (BS.length . BS.map toLower) bsa
369 , bench "bl" $ nf (BL.length . BL.map toLower) bla
370 , bench "l" $ nf (L.length . L.map toLower) la
371 ],
372 bgroup "toUpper" [
373 bench "ts" $ nf (TS.length . TS.toUpper) tsa
374 , bench "tl" $ nf (TL.length . TL.toUpper) tla
375 , bench "bs" $ nf (BS.length . BS.map toUpper) bsa
376 , bench "bl" $ nf (BL.length . BL.map toUpper) bla
377 , bench "l" $ nf (L.length . L.map toUpper) la
378 ],
379 bgroup "words" [
380 bench "ts" $ nf (L.length . TS.words) tsa
381 , bench "tl" $ nf (L.length . TL.words) tla
382 , bench "bs" $ nf (L.length . BS.words) bsa
383 , bench "bl" $ nf (L.length . BL.words) bla
384 , bench "l" $ nf (L.length . L.words) la
385 ],
386 bgroup "zipWith" [
387 bench "ts" $ nf (TS.length . TS.zipWith min tsb) tsa
388 , bench "tl" $ nf (TL.length . TL.zipWith min tlb) tla
389 , bench "bs" $ nf (L.length . BS.zipWith min bsb) bsa
390 , bench "bl" $ nf (L.length . BL.zipWith min blb) bla
391 , bench "l" $ nf (L.length . L.zipWith min lb) la
392 ]
393 ],
394 bgroup "builder" [
395 bench "mappend char" $ nf (TL.length . TB.toLazyText . mappendNChar 'a') 10000,
396 bench "mappend 8 char" $ nf (TL.length . TB.toLazyText . mappend8Char) 'a',
397 bench "mappend text" $ nf (TL.length . TB.toLazyText . mappendNText short) 10000
398 ]
399 ]
400 where
401 c = 'й'
402 p0 = (== c)
403 p1 = (/= 'д')
404 lw = "право"
405 bsw = UTF8.fromString lw
406 blw = BL.fromChunks [bsw]
407 tsw = TS.pack lw
408 tlw = TL.fromChunks [tsw]
409 f (C# c#) = C# (chr# (ord# c# +# 1#))
410 len l _ = l + (1::Int)
411 replicat n = concat . L.replicate n
412 short = TS.pack "short"
414chunksOf :: Int -> BS.ByteString -> [BS.ByteString]
415chunksOf k = go
416 where
417 go t = case BS.splitAt k t of
418 (a,b) | BS.null a -> []
419 | otherwise -> a : go b
421mappendNChar :: Char -> Int -> TB.Builder
422mappendNChar c n = go 0
423 where
424 go i
425 | i < n = TB.singleton c `mappend` go (i+1)
426 | otherwise = mempty
428-- Gives more opportunity for inlining and elimination of unnecesary
429-- bounds checks.
430mappend8Char :: Char -> TB.Builder
431mappend8Char c = TB.singleton c `mappend` TB.singleton c `mappend`
432 TB.singleton c `mappend` TB.singleton c `mappend`
433 TB.singleton c `mappend` TB.singleton c `mappend`
434 TB.singleton c `mappend` TB.singleton c
436mappendNText :: TS.Text -> Int -> TB.Builder
437mappendNText t n = go 0
438 where
439 go i
440 | i < n = TB.fromText t `mappend` go (i+1)
441 | otherwise = mempty