2-- Module : Streamly.Benchmark.FileSystem.Handle
3-- Copyright : (c) 2019 Composewell Technologies
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Stability : experimental
10{-# LANGUAGE ScopedTypeVariables #-}
12#ifdef __HADDOCK_VERSION__
17{-# LANGUAGE TemplateHaskell #-}
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
25import Data.Functor.Identity (runIdentity)
26import Data.Word (Word8)
27import GHC.Magic (inline)
28#if __GLASGOW_HASKELL__ >= 802
29import GHC.Magic (noinline)
33import System.IO (Handle)
35import qualified Streamly.FileSystem.Handle as FH
36import qualified Streamly.Internal.Data.Array.Storable.Foreign as A
37import qualified Streamly.Internal.Data.Array.Storable.Foreign.Types as AT
38import qualified Streamly.Internal.Data.Fold as FL
39import qualified Streamly.Internal.Data.Parser as PR
40import qualified Streamly.Internal.Data.Stream.IsStream as IP
41import qualified Streamly.Internal.FileSystem.Handle as IFH
42import qualified Streamly.Internal.Memory.ArrayStream as AS
43import qualified Streamly.Internal.Unicode.Stream as IUS
44import qualified Streamly.Prelude as S
45import qualified Streamly.Unicode.Stream as SS
47import Gauge hiding (env)
48import Prelude hiding (last, length)
49import Streamly.Benchmark.Common.Handle
52import Streamly.Internal.Data.Stream.StreamD.Type (Step(..), GroupState)
54import qualified Streamly.Internal.Data.Stream.StreamD as D
55import qualified Streamly.Internal.Data.Unfold as IUF
60-------------------------------------------------------------------------------
61-- read chunked using toChunks
62-------------------------------------------------------------------------------
64-- | Get the last byte from a file bytestream.
65toChunksLast :: Handle -> IO (Maybe Word8)
67 let s = IFH.toChunks inh
71 Just arr -> A.readIndex arr (A.length arr - 1)
74inspect $ hasNoTypeClasses 'toChunksLast
75inspect $ 'toChunksLast `hasNoType` ''Step
78-- | Count the number of bytes in a file.
79toChunksSumLengths :: Handle -> IO Int
80toChunksSumLengths inh =
81 let s = IFH.toChunks inh
82 in S.sum (S.map A.length s)
85inspect $ hasNoTypeClasses 'toChunksSumLengths
86inspect $ 'toChunksSumLengths `hasNoType` ''Step
89-- | Count the number of lines in a file.
90toChunksSplitOnSuffix :: Handle -> IO Int
91toChunksSplitOnSuffix = S.length . AS.splitOnSuffix 10 . IFH.toChunks
94inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix
95inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step
98-- XXX use a word splitting combinator instead of splitOn and test it.
99-- | Count the number of words in a file.
100toChunksSplitOn :: Handle -> IO Int
101toChunksSplitOn = S.length . AS.splitOn 32 . IFH.toChunks
104inspect $ hasNoTypeClasses 'toChunksSplitOn
105inspect $ 'toChunksSplitOn `hasNoType` ''Step
108-- | Sum the bytes in a file.
109toChunksCountBytes :: Handle -> IO Word8
110toChunksCountBytes inh = do
111 let foldlArr' f z = runIdentity . S.foldl' f z . A.toStream
112 let s = IFH.toChunks inh
113 S.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
116inspect $ hasNoTypeClasses 'toChunksCountBytes
117inspect $ 'toChunksCountBytes `hasNoType` ''Step
120toChunksDecodeUtf8Arrays :: Handle -> IO ()
121toChunksDecodeUtf8Arrays =
122 S.drain . IUS.decodeUtf8Arrays . IFH.toChunks
125inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays
126-- inspect $ 'toChunksDecodeUtf8ArraysLenient `hasNoType` ''Step
129o_1_space_read_chunked :: BenchEnv -> [Benchmark]
130o_1_space_read_chunked env =
131 -- read using toChunks instead of read
132 [ bgroup "reduce/toChunks"
133 [ mkBench "S.last" env $ \inH _ ->
135 -- Note: this cannot be fairly compared with GNU wc -c or wc -m as
136 -- wc uses lseek to just determine the file size rather than reading
137 -- and counting characters.
138 , mkBench "S.sum . S.map A.length" env $ \inH _ ->
139 toChunksSumLengths inH
140 , mkBench "AS.splitOnSuffix" env $ \inH _ ->
141 toChunksSplitOnSuffix inH
142 , mkBench "AS.splitOn" env $ \inH _ ->
144 , mkBench "countBytes" env $ \inH _ ->
145 toChunksCountBytes inH
146 , mkBenchSmall "US.decodeUtf8Arrays" env $ \inH _ ->
147 toChunksDecodeUtf8Arrays inH
151-- TBD reading with unfold
153-------------------------------------------------------------------------------
155-------------------------------------------------------------------------------
157-- | Get the last byte from a file bytestream.
158readLast :: Handle -> IO (Maybe Word8)
159readLast = S.last . S.unfold FH.read
162inspect $ hasNoTypeClasses 'readLast
163inspect $ 'readLast `hasNoType` ''Step -- S.unfold
164inspect $ 'readLast `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
165inspect $ 'readLast `hasNoType` ''A.ReadUState -- FH.read/A.read
168-- assert that flattenArrays constructors are not present
169-- | Count the number of bytes in a file.
170readCountBytes :: Handle -> IO Int
171readCountBytes = S.length . S.unfold FH.read
174inspect $ hasNoTypeClasses 'readCountBytes
175inspect $ 'readCountBytes `hasNoType` ''Step -- S.unfold
176inspect $ 'readCountBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
177inspect $ 'readCountBytes `hasNoType` ''A.ReadUState -- FH.read/A.read
180-- | Count the number of lines in a file.
181readCountLines :: Handle -> IO Int
189inspect $ hasNoTypeClasses 'readCountLines
190inspect $ 'readCountLines `hasNoType` ''Step
191inspect $ 'readCountLines `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
192inspect $ 'readCountLines `hasNoType` ''A.ReadUState -- FH.read/A.read
195-- | Count the number of words in a file.
196readCountWords :: Handle -> IO Int
204inspect $ hasNoTypeClasses 'readCountWords
205-- inspect $ 'readCountWords `hasNoType` ''Step
208-- | Sum the bytes in a file.
209readSumBytes :: Handle -> IO Word8
210readSumBytes = S.sum . S.unfold FH.read
213inspect $ hasNoTypeClasses 'readSumBytes
214inspect $ 'readSumBytes `hasNoType` ''Step
215inspect $ 'readSumBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
216inspect $ 'readSumBytes `hasNoType` ''A.ReadUState -- FH.read/A.read
219-- XXX When we mark this with INLINE and we have two benchmarks using S.drain
220-- in one benchmark group then somehow GHC ends up delaying the inlining of
221-- readDrain. Since S.drain has an INLINE[2] for proper rule firing, that does
222-- not work well because of delyaed inlining and the code does not fuse. We
223-- need some way of propagating the inline phase information up so that we can
224-- expedite inlining of the callers too automatically. The minimal example for
225-- the problem can be created by using just two benchmarks in a bench group
226-- both using "readDrain". Either GHC should be fixed or we can use
227-- fusion-plugin to propagate INLINE phase information such that this problem
229readDrain :: Handle -> IO ()
230readDrain inh = S.drain $ S.unfold FH.read inh
232-- XXX investigate why we need an INLINE in this case (GHC)
233{-# INLINE readDecodeLatin1 #-}
234readDecodeLatin1 :: Handle -> IO ()
235readDecodeLatin1 inh =
238 $ S.unfold FH.read inh
240readDecodeUtf8 :: Handle -> IO ()
244 $ S.unfold FH.read inh
247inspect $ hasNoTypeClasses 'readDecodeUtf8
248-- inspect $ 'readDecodeUtf8Lax `hasNoType` ''Step
251o_1_space_reduce_read :: BenchEnv -> [Benchmark]
252o_1_space_reduce_read env =
253 [ bgroup "reduce/read"
254 [ -- read raw bytes without any decoding
255 mkBench "S.drain" env $ \inh _ ->
257 , mkBench "S.last" env $ \inh _ ->
259 , mkBench "S.sum" env $ \inh _ ->
262 -- read with Latin1 decoding
263 , mkBench "SS.decodeLatin1" env $ \inh _ ->
265 , mkBench "S.length" env $ \inh _ ->
267 , mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->
269 , mkBenchSmall "US.words . SS.decodeLatin1" env $ \inh _ ->
272 -- read with utf8 decoding
273 , mkBenchSmall "SS.decodeUtf8" env $ \inh _ ->
278-------------------------------------------------------------------------------
280-------------------------------------------------------------------------------
282-- | Count the number of lines in a file.
283toChunksConcatUnfoldCountLines :: Handle -> IO Int
284toChunksConcatUnfoldCountLines inh =
288 -- XXX replace with toBytes
289 $ S.concatUnfold A.read (IFH.toChunks inh)
292inspect $ hasNoTypeClasses 'toChunksConcatUnfoldCountLines
293inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''Step
294inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''D.ConcatMapUState
297o_1_space_reduce_toBytes :: BenchEnv -> [Benchmark]
298o_1_space_reduce_toBytes env =
299 [ bgroup "reduce/toBytes"
300 [ mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->
301 toChunksConcatUnfoldCountLines inh
305-------------------------------------------------------------------------------
306-- reduce after grouping in chunks
307-------------------------------------------------------------------------------
309chunksOfSum :: Int -> Handle -> IO Int
310chunksOfSum n inh = S.length $ S.chunksOf n FL.sum (S.unfold FH.read inh)
312foldManyChunksOfSum :: Int -> Handle -> IO Int
313foldManyChunksOfSum n inh =
314 S.length $ IP.foldMany (FL.ltake n FL.sum) (S.unfold FH.read inh)
316parseManyChunksOfSum :: Int -> Handle -> IO Int
317parseManyChunksOfSum n inh =
319 $ IP.parseMany (PR.fromFold $ FL.ltake n FL.sum) (S.unfold FH.read inh)
321-- XXX investigate why we need an INLINE in this case (GHC)
322-- Even though allocations remain the same in both cases inlining improves time
324-- | Slice in chunks of size n and get the count of chunks.
325{-# INLINE chunksOf #-}
326chunksOf :: Int -> Handle -> IO Int
328 -- writeNUnsafe gives 2.5x boost here over writeN.
329 -- XXX replace with S.arraysOf
330 S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.read inh)
333inspect $ hasNoTypeClasses 'chunksOf
334inspect $ 'chunksOf `hasNoType` ''Step
335inspect $ 'chunksOf `hasNoType` ''GroupState
336inspect $ 'chunksOf `hasNoType` ''AT.ArrayUnsafe -- AT.writeNUnsafe
337inspect $ 'chunksOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
338inspect $ 'chunksOf `hasNoType` ''A.ReadUState -- FH.read/A.read
341o_1_space_reduce_read_grouped :: BenchEnv -> [Benchmark]
342o_1_space_reduce_read_grouped env =
343 [ bgroup "reduce/read/chunks"
344 [ mkBench ("S.chunksOf " ++ show (bigSize env) ++ " FL.sum") env $
346 chunksOfSum (bigSize env) inh
347 , mkBench "S.chunksOf 1 FL.sum" env $ \inh _ ->
350 -- XXX investigate why we need inline/noinline in these cases (GHC)
351 -- Chunk using parsers
353 ("S.foldMany (FL.take " ++ show (bigSize env) ++ " FL.sum)")
355 $ \inh _ -> noinline foldManyChunksOfSum (bigSize env) inh
357 "S.foldMany (FL.take 1 FL.sum)"
359 $ \inh _ -> inline foldManyChunksOfSum 1 inh
361 ("S.parseMany (FL.take " ++ show (bigSize env) ++ " FL.sum)")
363 $ \inh _ -> noinline parseManyChunksOfSum (bigSize env) inh
365 "S.parseMany (FL.take 1 FL.sum)"
367 $ \inh _ -> inline parseManyChunksOfSum 1 inh
369 -- folding chunks to arrays
370 , mkBenchSmall "S.arraysOf 1" env $ \inh _ ->
372 , mkBench "S.arraysOf 10" env $ \inh _ ->
374 , mkBench "S.arraysOf 1000" env $ \inh _ ->
379allBenchmarks :: BenchEnv -> [Benchmark]
380allBenchmarks env = Prelude.concat
381 [ o_1_space_read_chunked env
382 , o_1_space_reduce_read env
383 , o_1_space_reduce_toBytes env
384 , o_1_space_reduce_read_grouped env
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list