git.iko.soy/streamly
on 2d4ab16 help sign in
streamly/benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs
534 lines 19 kB history raw
1-- |
2-- Module : Streamly.Benchmark.FileSystem.Handle
3-- Copyright : (c) 2019 Composewell Technologies
4--
5-- License : BSD3
6-- Maintainer : streamly@composewell.com
7-- Stability : experimental
8-- Portability : GHC
10{-# LANGUAGE CPP #-}
11{-# LANGUAGE ScopedTypeVariables #-}
13#ifdef __HADDOCK_VERSION__
14#undef INSPECTION
15#endif
17#ifdef INSPECTION
18{-# LANGUAGE TemplateHaskell #-}
19{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
20#endif
22module Handle.Read
23 (allBenchmarks)
24where
26import Data.Char (ord)
27import Data.Functor.Identity (runIdentity)
28import Data.Word (Word8)
29import GHC.Magic (inline)
30#if __GLASGOW_HASKELL__ >= 802
31import GHC.Magic (noinline)
32#else
33#define noinline
34#endif
35import System.IO (Handle)
36import Prelude hiding (last, length)
38import qualified Streamly.Data.Fold as FL
39import qualified Streamly.Unicode.Stream as SS
40import qualified Streamly.FileSystem.Handle as FH
41-- import qualified Streamly.Internal.Data.Fold as IFL
42import qualified Streamly.Internal.Data.Parser as PR
43import qualified Streamly.Internal.Data.Stream.StreamD as D
44import qualified Streamly.Internal.Unicode.Stream as IUS
45import qualified Streamly.Internal.FileSystem.Handle as IFH
46import qualified Streamly.Internal.Data.Array.Storable.Foreign as A
47import qualified Streamly.Internal.Data.Array.Storable.Foreign.Types as AT
48import qualified Streamly.Internal.Memory.ArrayStream as AS
49import qualified Streamly.Internal.Data.Stream.IsStream as IP
50import qualified Streamly.Prelude as S
52import Gauge hiding (env)
53import Handle.Common
55#ifdef INSPECTION
56import Streamly.Internal.Data.Stream.StreamD.Type (Step(..), GroupState)
58import qualified Streamly.Internal.Data.Unfold as IUF
60import Test.Inspection
61#endif
63-------------------------------------------------------------------------------
64-- read chunked using toChunks
65-------------------------------------------------------------------------------
67-- | Get the last byte from a file bytestream.
68toChunksLast :: Handle -> IO (Maybe Word8)
69toChunksLast inh = do
70 let s = IFH.toChunks inh
71 larr <- S.last s
72 return $ case larr of
73 Nothing -> Nothing
74 Just arr -> A.readIndex arr (A.length arr - 1)
76#ifdef INSPECTION
77inspect $ hasNoTypeClasses 'toChunksLast
78inspect $ 'toChunksLast `hasNoType` ''Step
79#endif
81-- | Count the number of bytes in a file.
82toChunksSumLengths :: Handle -> IO Int
83toChunksSumLengths inh =
84 let s = IFH.toChunks inh
85 in S.sum (S.map A.length s)
87#ifdef INSPECTION
88inspect $ hasNoTypeClasses 'toChunksSumLengths
89inspect $ 'toChunksSumLengths `hasNoType` ''Step
90#endif
92-- | Count the number of lines in a file.
93toChunksSplitOnSuffix :: Handle -> IO Int
94toChunksSplitOnSuffix = S.length . AS.splitOnSuffix 10 . IFH.toChunks
96#ifdef INSPECTION
97inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix
98inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step
99#endif
101-- XXX use a word splitting combinator instead of splitOn and test it.
102-- | Count the number of words in a file.
103toChunksSplitOn :: Handle -> IO Int
104toChunksSplitOn = S.length . AS.splitOn 32 . IFH.toChunks
106#ifdef INSPECTION
107inspect $ hasNoTypeClasses 'toChunksSplitOn
108inspect $ 'toChunksSplitOn `hasNoType` ''Step
109#endif
111-- | Sum the bytes in a file.
112toChunksCountBytes :: Handle -> IO Word8
113toChunksCountBytes inh = do
114 let foldlArr' f z = runIdentity . S.foldl' f z . A.toStream
115 let s = IFH.toChunks inh
116 S.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
118#ifdef INSPECTION
119inspect $ hasNoTypeClasses 'toChunksCountBytes
120inspect $ 'toChunksCountBytes `hasNoType` ''Step
121#endif
123toChunksDecodeUtf8Arrays :: Handle -> IO ()
124toChunksDecodeUtf8Arrays =
125 S.drain . IUS.decodeUtf8Arrays . IFH.toChunks
127#ifdef INSPECTION
128inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays
129-- inspect $ 'toChunksDecodeUtf8ArraysLenient `hasNoType` ''Step
130#endif
132o_1_space_read_chunked :: BenchEnv -> [Benchmark]
133o_1_space_read_chunked env =
134 -- read using toChunks instead of read
135 [ bgroup "reduce/toChunks"
136 [ mkBench "S.last" env $ \inH _ ->
137 toChunksLast inH
138 -- Note: this cannot be fairly compared with GNU wc -c or wc -m as
139 -- wc uses lseek to just determine the file size rather than reading
140 -- and counting characters.
141 , mkBench "S.sum . S.map A.length" env $ \inH _ ->
142 toChunksSumLengths inH
143 , mkBench "AS.splitOnSuffix" env $ \inH _ ->
144 toChunksSplitOnSuffix inH
145 , mkBench "AS.splitOn" env $ \inH _ ->
146 toChunksSplitOn inH
147 , mkBench "countBytes" env $ \inH _ ->
148 toChunksCountBytes inH
149 , mkBenchSmall "US.decodeUtf8Arrays" env $ \inH _ ->
150 toChunksDecodeUtf8Arrays inH
151 ]
152 ]
154-- TBD reading with unfold
156-------------------------------------------------------------------------------
157-- unfold read
158-------------------------------------------------------------------------------
160-- | Get the last byte from a file bytestream.
161readLast :: Handle -> IO (Maybe Word8)
162readLast = S.last . S.unfold FH.read
164#ifdef INSPECTION
165inspect $ hasNoTypeClasses 'readLast
166inspect $ 'readLast `hasNoType` ''Step -- S.unfold
167inspect $ 'readLast `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
168inspect $ 'readLast `hasNoType` ''A.ReadUState -- FH.read/A.read
169#endif
171-- assert that flattenArrays constructors are not present
172-- | Count the number of bytes in a file.
173readCountBytes :: Handle -> IO Int
174readCountBytes = S.length . S.unfold FH.read
176#ifdef INSPECTION
177inspect $ hasNoTypeClasses 'readCountBytes
178inspect $ 'readCountBytes `hasNoType` ''Step -- S.unfold
179inspect $ 'readCountBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
180inspect $ 'readCountBytes `hasNoType` ''A.ReadUState -- FH.read/A.read
181#endif
183-- | Count the number of lines in a file.
184readCountLines :: Handle -> IO Int
185readCountLines =
186 S.length
187 . IUS.lines FL.drain
188 . SS.decodeLatin1
189 . S.unfold FH.read
191#ifdef INSPECTION
192inspect $ hasNoTypeClasses 'readCountLines
193inspect $ 'readCountLines `hasNoType` ''Step
194inspect $ 'readCountLines `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
195inspect $ 'readCountLines `hasNoType` ''A.ReadUState -- FH.read/A.read
196#endif
198-- | Count the number of words in a file.
199readCountWords :: Handle -> IO Int
200readCountWords =
201 S.length
202 . IUS.words FL.drain
203 . SS.decodeLatin1
204 . S.unfold FH.read
206#ifdef INSPECTION
207inspect $ hasNoTypeClasses 'readCountWords
208-- inspect $ 'readCountWords `hasNoType` ''Step
209#endif
211-- | Sum the bytes in a file.
212readSumBytes :: Handle -> IO Word8
213readSumBytes = S.sum . S.unfold FH.read
215#ifdef INSPECTION
216inspect $ hasNoTypeClasses 'readSumBytes
217inspect $ 'readSumBytes `hasNoType` ''Step
218inspect $ 'readSumBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
219inspect $ 'readSumBytes `hasNoType` ''A.ReadUState -- FH.read/A.read
220#endif
222-- XXX When we mark this with INLINE and we have two benchmarks using S.drain
223-- in one benchmark group then somehow GHC ends up delaying the inlining of
224-- readDrain. Since S.drain has an INLINE[2] for proper rule firing, that does
225-- not work well because of delyaed inlining and the code does not fuse. We
226-- need some way of propagating the inline phase information up so that we can
227-- expedite inlining of the callers too automatically. The minimal example for
228-- the problem can be created by using just two benchmarks in a bench group
229-- both using "readDrain". Either GHC should be fixed or we can use
230-- fusion-plugin to propagate INLINE phase information such that this problem
231-- does not occur.
232readDrain :: Handle -> IO ()
233readDrain inh = S.drain $ S.unfold FH.read inh
235-- XXX investigate why we need an INLINE in this case (GHC)
236{-# INLINE readDecodeLatin1 #-}
237readDecodeLatin1 :: Handle -> IO ()
238readDecodeLatin1 inh =
239 S.drain
240 $ SS.decodeLatin1
241 $ S.unfold FH.read inh
243readDecodeUtf8 :: Handle -> IO ()
244readDecodeUtf8 inh =
245 S.drain
246 $ SS.decodeUtf8
247 $ S.unfold FH.read inh
249#ifdef INSPECTION
250inspect $ hasNoTypeClasses 'readDecodeUtf8
251-- inspect $ 'readDecodeUtf8Lax `hasNoType` ''Step
252#endif
254o_1_space_reduce_read :: BenchEnv -> [Benchmark]
255o_1_space_reduce_read env =
256 [ bgroup "reduce/read"
257 [ -- read raw bytes without any decoding
258 mkBench "S.drain" env $ \inh _ ->
259 readDrain inh
260 , mkBench "S.last" env $ \inh _ ->
261 readLast inh
262 , mkBench "S.sum" env $ \inh _ ->
263 readSumBytes inh
265 -- read with Latin1 decoding
266 , mkBench "SS.decodeLatin1" env $ \inh _ ->
267 readDecodeLatin1 inh
268 , mkBench "S.length" env $ \inh _ ->
269 readCountBytes inh
270 , mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->
271 readCountLines inh
272 , mkBenchSmall "US.words . SS.decodeLatin1" env $ \inh _ ->
273 readCountWords inh
275 -- read with utf8 decoding
276 , mkBenchSmall "SS.decodeUtf8" env $ \inh _ ->
277 readDecodeUtf8 inh
278 ]
279 ]
281-------------------------------------------------------------------------------
282-- stream toBytes
283-------------------------------------------------------------------------------
285-- | Count the number of lines in a file.
286toChunksConcatUnfoldCountLines :: Handle -> IO Int
287toChunksConcatUnfoldCountLines inh =
288 S.length
289 $ IUS.lines FL.drain
290 $ SS.decodeLatin1
291 -- XXX replace with toBytes
292 $ S.concatUnfold A.read (IFH.toChunks inh)
294#ifdef INSPECTION
295inspect $ hasNoTypeClasses 'toChunksConcatUnfoldCountLines
296inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''Step
297inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''D.ConcatMapUState
298#endif
300o_1_space_reduce_toBytes :: BenchEnv -> [Benchmark]
301o_1_space_reduce_toBytes env =
302 [ bgroup "reduce/toBytes"
303 [ mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->
304 toChunksConcatUnfoldCountLines inh
305 ]
306 ]
308-------------------------------------------------------------------------------
309-- reduce after grouping in chunks
310-------------------------------------------------------------------------------
312chunksOfSum :: Int -> Handle -> IO Int
313chunksOfSum n inh = S.length $ S.chunksOf n FL.sum (S.unfold FH.read inh)
315parseManyChunksOfSum :: Int -> Handle -> IO Int
316parseManyChunksOfSum n inh =
317 S.length $ IP.parseMany (PR.take n FL.sum) (S.unfold FH.read inh)
319-- XXX investigate why we need an INLINE in this case (GHC)
320-- Even though allocations remain the same in both cases inlining improves time
321-- by 4x.
322-- | Slice in chunks of size n and get the count of chunks.
323{-# INLINE chunksOf #-}
324chunksOf :: Int -> Handle -> IO Int
325chunksOf n inh =
326 -- writeNUnsafe gives 2.5x boost here over writeN.
327 -- XXX replace with S.arraysOf
328 S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.read inh)
330#ifdef INSPECTION
331inspect $ hasNoTypeClasses 'chunksOf
332inspect $ 'chunksOf `hasNoType` ''Step
333inspect $ 'chunksOf `hasNoType` ''GroupState
334inspect $ 'chunksOf `hasNoType` ''AT.ArrayUnsafe -- AT.writeNUnsafe
335inspect $ 'chunksOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
336inspect $ 'chunksOf `hasNoType` ''A.ReadUState -- FH.read/A.read
337#endif
339-- This is to make sure that the concatMap in FH.read, groupsOf and foldlM'
340-- together can fuse.
341--
342-- | Slice in chunks of size n and get the count of chunks.
343_chunksOfD :: Int -> Handle -> IO Int
344_chunksOfD n inh =
345 D.foldlM' (\i _ -> return $ i + 1) (return 0)
346 $ D.groupsOf n (AT.writeNUnsafe n)
347 $ D.fromStreamK (S.unfold FH.read inh)
349#ifdef INSPECTION
350inspect $ hasNoTypeClasses '_chunksOfD
351inspect $ '_chunksOfD `hasNoType` ''Step
352inspect $ '_chunksOfD `hasNoType` ''GroupState
353inspect $ '_chunksOfD `hasNoType` ''AT.ArrayUnsafe -- AT.writeNUnsafe
354inspect $ '_chunksOfD `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
355inspect $ '_chunksOfD `hasNoType` ''A.ReadUState -- FH.read/A.read
356#endif
358o_1_space_reduce_read_grouped :: BenchEnv -> [Benchmark]
359o_1_space_reduce_read_grouped env =
360 [ bgroup "reduce/read/chunks"
361 [ mkBench ("S.chunksOf " ++ show (bigSize env) ++ " FL.sum") env $
362 \inh _ ->
363 chunksOfSum (bigSize env) inh
364 , mkBench "S.chunksOf 1 FL.sum" env $ \inh _ ->
365 chunksOfSum 1 inh
367 -- XXX investigate why we need inline/noinline in these cases (GHC)
368 -- Chunk using parsers
369 , mkBenchSmall ("S.parseMany (PR.take " ++ show (bigSize env) ++ " FL.sum)")
370 env $ \inh _ ->
371 noinline parseManyChunksOfSum (bigSize env) inh
372 , mkBench "S.parseMany (PR.take 1 FL.sum)" env $ \inh _ ->
373 inline parseManyChunksOfSum 1 inh
375 -- folding chunks to arrays
376 , mkBenchSmall "S.arraysOf 1" env $ \inh _ ->
377 chunksOf 1 inh
378 , mkBench "S.arraysOf 10" env $ \inh _ ->
379 chunksOf 10 inh
380 , mkBench "S.arraysOf 1000" env $ \inh _ ->
381 chunksOf 1000 inh
382 ]
383 ]
385-------------------------------------------------------------------------------
386-- reduce with splitting transformations
387-------------------------------------------------------------------------------
389lf :: Word8
390lf = fromIntegral (ord '\n')
392toarr :: String -> A.Array Word8
393toarr = A.fromList . map (fromIntegral . ord)
395-- | Split on line feed.
396splitOn :: Handle -> IO Int
397splitOn inh =
398 (S.length $ S.splitOn (== lf) FL.drain
399 $ S.unfold FH.read inh) -- >>= print
401#ifdef INSPECTION
402inspect $ hasNoTypeClasses 'splitOn
403inspect $ 'splitOn `hasNoType` ''Step
404inspect $ 'splitOn `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
405inspect $ 'splitOn `hasNoType` ''A.ReadUState -- FH.read/A.read
406#endif
408-- | Split suffix on line feed.
409splitOnSuffix :: Handle -> IO Int
410splitOnSuffix inh =
411 (S.length $ S.splitOnSuffix (== lf) FL.drain
412 $ S.unfold FH.read inh) -- >>= print
414#ifdef INSPECTION
415inspect $ hasNoTypeClasses 'splitOnSuffix
416inspect $ 'splitOnSuffix `hasNoType` ''Step
417inspect $ 'splitOnSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
418inspect $ 'splitOnSuffix `hasNoType` ''A.ReadUState -- FH.read/A.read
419#endif
421-- | Split on line feed.
422parseManySepBy :: Handle -> IO Int
423parseManySepBy inh =
424 (S.length $ IP.parseMany (PR.sliceSepBy (== lf) FL.drain)
425 (S.unfold FH.read inh)) -- >>= print
427-- | Words by space
428wordsBy :: Handle -> IO Int
429wordsBy inh =
430 (S.length $ S.wordsBy isSp FL.drain
431 $ S.unfold FH.read inh) -- >>= print
433#ifdef INSPECTION
434inspect $ hasNoTypeClasses 'wordsBy
435inspect $ 'wordsBy `hasNoType` ''Step
436inspect $ 'wordsBy `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
437inspect $ 'wordsBy `hasNoType` ''A.ReadUState -- FH.read/A.read
438#endif
440-- | Split on a word8 sequence.
441splitOnSeq :: String -> Handle -> IO Int
442splitOnSeq str inh =
443 (S.length $ IP.splitOnSeq (toarr str) FL.drain
444 $ S.unfold FH.read inh) -- >>= print
446#ifdef INSPECTION
447-- inspect $ hasNoTypeClasses 'splitOnSeq
448-- inspect $ 'splitOnSeq `hasNoType` ''Step
449#endif
451-- | Split on suffix sequence.
452splitOnSuffixSeq :: String -> Handle -> IO Int
453splitOnSuffixSeq str inh =
454 (S.length $ IP.splitOnSuffixSeq (toarr str) FL.drain
455 $ S.unfold FH.read inh) -- >>= print
457#ifdef INSPECTION
458-- inspect $ hasNoTypeClasses 'splitOnSuffixSeq
459-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step
460#endif
462o_1_space_reduce_read_split :: BenchEnv -> [Benchmark]
463o_1_space_reduce_read_split env =
464 [ bgroup "reduce/read"
465 [ mkBench "S.parseMany (PR.sliceSepBy (== lf) FL.drain)" env
466 $ \inh _ -> parseManySepBy inh
467 , mkBench "S.wordsBy isSpace FL.drain" env $ \inh _ ->
468 wordsBy inh
469 , mkBench "S.splitOn (== lf) FL.drain" env $ \inh _ ->
470 splitOn inh
471 , mkBench "S.splitOnSuffix (== lf) FL.drain" env $ \inh _ ->
472 splitOnSuffix inh
473 , mkBench "S.splitOnSeq \"\" FL.drain" env $ \inh _ ->
474 splitOnSeq "" inh
475 , mkBench "S.splitOnSuffixSeq \"\" FL.drain" env $ \inh _ ->
476 splitOnSuffixSeq "" inh
477 , mkBench "S.splitOnSeq \"\\n\" FL.drain" env $ \inh _ ->
478 splitOnSeq "\n" inh
479 , mkBench "S.splitOnSuffixSeq \"\\n\" FL.drain" env $ \inh _ ->
480 splitOnSuffixSeq "\n" inh
481 , mkBench "S.splitOnSeq \"a\" FL.drain" env $ \inh _ ->
482 splitOnSeq "a" inh
483 , mkBench "S.splitOnSeq \"\\r\\n\" FL.drain" env $ \inh _ ->
484 splitOnSeq "\r\n" inh
485 , mkBench "S.splitOnSuffixSeq \"\\r\\n\" FL.drain" env $ \inh _ ->
486 splitOnSuffixSeq "\r\n" inh
487 , mkBench "S.splitOnSeq \"aa\" FL.drain" env $ \inh _ ->
488 splitOnSeq "aa" inh
489 , mkBench "S.splitOnSeq \"aaaa\" FL.drain" env $ \inh _ ->
490 splitOnSeq "aaaa" inh
491 , mkBench "S.splitOnSeq \"abcdefgh\" FL.drain" env $ \inh _ ->
492 splitOnSeq "abcdefgh" inh
493 , mkBench "S.splitOnSeq \"abcdefghi\" FL.drain" env $ \inh _ ->
494 splitOnSeq "abcdefghi" inh
495 , mkBench "S.splitOnSeq \"catcatcatcatcat\" FL.drain" env $ \inh _ ->
496 splitOnSeq "catcatcatcatcat" inh
497 , mkBench "S.splitOnSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
498 env $ \inh _ -> splitOnSeq "abcdefghijklmnopqrstuvwxyz" inh
499 , mkBenchSmall "S.splitOnSuffixSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
500 env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh
501 ]
502 ]
504-- | Split on a character sequence.
505splitOnSeqUtf8 :: String -> Handle -> IO Int
506splitOnSeqUtf8 str inh =
507 (S.length $ IP.splitOnSeq (A.fromList str) FL.drain
508 $ IUS.decodeUtf8Arrays
509 $ IFH.toChunks inh) -- >>= print
511o_1_space_reduce_toChunks_split :: BenchEnv -> [Benchmark]
512o_1_space_reduce_toChunks_split env =
513 [ bgroup "reduce/toChunks"
514 [ mkBenchSmall ("S.splitOnSeqUtf8 \"abcdefgh\" FL.drain "
515 ++ ". US.decodeUtf8Arrays") env $ \inh _ ->
516 splitOnSeqUtf8 "abcdefgh" inh
517 , mkBenchSmall "S.splitOnSeqUtf8 \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
518 env $ \inh _ -> splitOnSeqUtf8 "abcdefghijklmnopqrstuvwxyz" inh
519 ]
520 ]
522-------------------------------------------------------------------------------
523--
524-------------------------------------------------------------------------------
526allBenchmarks :: BenchEnv -> [Benchmark]
527allBenchmarks env = Prelude.concat
528 [ o_1_space_read_chunked env
529 , o_1_space_reduce_read env
530 , o_1_space_reduce_toBytes env
531 , o_1_space_reduce_read_grouped env
532 , o_1_space_reduce_read_split env
533 , o_1_space_reduce_toChunks_split env
534 ]