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.Array.Storable.Foreign.Mut.Types as MA
55import qualified Streamly.Internal.Data.Stream.StreamD as D
56import qualified Streamly.Internal.Data.Unfold as IUF
61-------------------------------------------------------------------------------
62-- read chunked using toChunks
63-------------------------------------------------------------------------------
65-- | Get the last byte from a file bytestream.
66toChunksLast :: Handle -> IO (Maybe Word8)
68 let s = IFH.toChunks inh
72 Just arr -> A.readIndex arr (A.length arr - 1)
75inspect $ hasNoTypeClasses 'toChunksLast
76inspect $ 'toChunksLast `hasNoType` ''Step
79-- | Count the number of bytes in a file.
80toChunksSumLengths :: Handle -> IO Int
81toChunksSumLengths inh =
82 let s = IFH.toChunks inh
83 in S.sum (S.map A.length s)
86inspect $ hasNoTypeClasses 'toChunksSumLengths
87inspect $ 'toChunksSumLengths `hasNoType` ''Step
90-- | Count the number of lines in a file.
91toChunksSplitOnSuffix :: Handle -> IO Int
92toChunksSplitOnSuffix = S.length . AS.splitOnSuffix 10 . IFH.toChunks
95inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix
96inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step
99-- XXX use a word splitting combinator instead of splitOn and test it.
100-- | Count the number of words in a file.
101toChunksSplitOn :: Handle -> IO Int
102toChunksSplitOn = S.length . AS.splitOn 32 . IFH.toChunks
105inspect $ hasNoTypeClasses 'toChunksSplitOn
106inspect $ 'toChunksSplitOn `hasNoType` ''Step
109-- | Sum the bytes in a file.
110toChunksCountBytes :: Handle -> IO Word8
111toChunksCountBytes inh = do
112 let foldlArr' f z = runIdentity . S.foldl' f z . A.toStream
113 let s = IFH.toChunks inh
114 S.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
117inspect $ hasNoTypeClasses 'toChunksCountBytes
118inspect $ 'toChunksCountBytes `hasNoType` ''Step
121toChunksDecodeUtf8Arrays :: Handle -> IO ()
122toChunksDecodeUtf8Arrays =
123 S.drain . IUS.decodeUtf8Arrays . IFH.toChunks
126inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays
127-- inspect $ 'toChunksDecodeUtf8ArraysLenient `hasNoType` ''Step
130o_1_space_read_chunked :: BenchEnv -> [Benchmark]
131o_1_space_read_chunked env =
132 -- read using toChunks instead of read
133 [ bgroup "reduce/toChunks"
134 [ mkBench "S.last" env $ \inH _ ->
136 -- Note: this cannot be fairly compared with GNU wc -c or wc -m as
137 -- wc uses lseek to just determine the file size rather than reading
138 -- and counting characters.
139 , mkBench "S.sum . S.map A.length" env $ \inH _ ->
140 toChunksSumLengths inH
141 , mkBench "AS.splitOnSuffix" env $ \inH _ ->
142 toChunksSplitOnSuffix inH
143 , mkBench "AS.splitOn" env $ \inH _ ->
145 , mkBench "countBytes" env $ \inH _ ->
146 toChunksCountBytes inH
147 , mkBenchSmall "US.decodeUtf8Arrays" env $ \inH _ ->
148 toChunksDecodeUtf8Arrays inH
152-- TBD reading with unfold
154-------------------------------------------------------------------------------
156-------------------------------------------------------------------------------
158-- | Get the last byte from a file bytestream.
159readLast :: Handle -> IO (Maybe Word8)
160readLast = S.last . S.unfold FH.read
163inspect $ hasNoTypeClasses 'readLast
164inspect $ 'readLast `hasNoType` ''Step -- S.unfold
165inspect $ 'readLast `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
166inspect $ 'readLast `hasNoType` ''MA.ReadUState -- FH.read/A.read
169-- assert that flattenArrays constructors are not present
170-- | Count the number of bytes in a file.
171readCountBytes :: Handle -> IO Int
172readCountBytes = S.length . S.unfold FH.read
175inspect $ hasNoTypeClasses 'readCountBytes
176inspect $ 'readCountBytes `hasNoType` ''Step -- S.unfold
177inspect $ 'readCountBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
178inspect $ 'readCountBytes `hasNoType` ''MA.ReadUState -- FH.read/A.read
181-- | Count the number of lines in a file.
182readCountLines :: Handle -> IO Int
190inspect $ hasNoTypeClasses 'readCountLines
191inspect $ 'readCountLines `hasNoType` ''Step
192inspect $ 'readCountLines `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
193inspect $ 'readCountLines `hasNoType` ''MA.ReadUState -- FH.read/A.read
196-- | Count the number of words in a file.
197readCountWords :: Handle -> IO Int
205inspect $ hasNoTypeClasses 'readCountWords
206-- inspect $ 'readCountWords `hasNoType` ''Step
209-- | Sum the bytes in a file.
210readSumBytes :: Handle -> IO Word8
211readSumBytes = S.sum . S.unfold FH.read
214inspect $ hasNoTypeClasses 'readSumBytes
215inspect $ 'readSumBytes `hasNoType` ''Step
216inspect $ 'readSumBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
217inspect $ 'readSumBytes `hasNoType` ''MA.ReadUState -- FH.read/A.read
220-- XXX When we mark this with INLINE and we have two benchmarks using S.drain
221-- in one benchmark group then somehow GHC ends up delaying the inlining of
222-- readDrain. Since S.drain has an INLINE[2] for proper rule firing, that does
223-- not work well because of delyaed inlining and the code does not fuse. We
224-- need some way of propagating the inline phase information up so that we can
225-- expedite inlining of the callers too automatically. The minimal example for
226-- the problem can be created by using just two benchmarks in a bench group
227-- both using "readDrain". Either GHC should be fixed or we can use
228-- fusion-plugin to propagate INLINE phase information such that this problem
230readDrain :: Handle -> IO ()
231readDrain inh = S.drain $ S.unfold FH.read inh
233-- XXX investigate why we need an INLINE in this case (GHC)
234{-# INLINE readDecodeLatin1 #-}
235readDecodeLatin1 :: Handle -> IO ()
236readDecodeLatin1 inh =
239 $ S.unfold FH.read inh
241readDecodeUtf8 :: Handle -> IO ()
245 $ S.unfold FH.read inh
248inspect $ hasNoTypeClasses 'readDecodeUtf8
249-- inspect $ 'readDecodeUtf8Lax `hasNoType` ''Step
252o_1_space_reduce_read :: BenchEnv -> [Benchmark]
253o_1_space_reduce_read env =
254 [ bgroup "reduce/read"
255 [ -- read raw bytes without any decoding
256 mkBench "S.drain" env $ \inh _ ->
258 , mkBench "S.last" env $ \inh _ ->
260 , mkBench "S.sum" env $ \inh _ ->
263 -- read with Latin1 decoding
264 , mkBench "SS.decodeLatin1" env $ \inh _ ->
266 , mkBench "S.length" env $ \inh _ ->
268 , mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->
270 , mkBenchSmall "US.words . SS.decodeLatin1" env $ \inh _ ->
273 -- read with utf8 decoding
274 , mkBenchSmall "SS.decodeUtf8" env $ \inh _ ->
279-------------------------------------------------------------------------------
281-------------------------------------------------------------------------------
283-- | Count the number of lines in a file.
284toChunksConcatUnfoldCountLines :: Handle -> IO Int
285toChunksConcatUnfoldCountLines inh =
289 -- XXX replace with toBytes
290 $ S.concatUnfold A.read (IFH.toChunks inh)
293inspect $ hasNoTypeClasses 'toChunksConcatUnfoldCountLines
294inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''Step
295inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''D.ConcatMapUState
298o_1_space_reduce_toBytes :: BenchEnv -> [Benchmark]
299o_1_space_reduce_toBytes env =
300 [ bgroup "reduce/toBytes"
301 [ mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->
302 toChunksConcatUnfoldCountLines inh
306-------------------------------------------------------------------------------
307-- reduce after grouping in chunks
308-------------------------------------------------------------------------------
310chunksOfSum :: Int -> Handle -> IO Int
311chunksOfSum n inh = S.length $ S.chunksOf n FL.sum (S.unfold FH.read inh)
313foldManyChunksOfSum :: Int -> Handle -> IO Int
314foldManyChunksOfSum n inh =
315 S.length $ IP.foldMany (FL.takeLE n FL.sum) (S.unfold FH.read inh)
317parseManyChunksOfSum :: Int -> Handle -> IO Int
318parseManyChunksOfSum n inh =
320 $ IP.parseMany (PR.fromFold $ FL.takeLE n FL.sum) (S.unfold FH.read inh)
322-- XXX investigate why we need an INLINE in this case (GHC)
323-- Even though allocations remain the same in both cases inlining improves time
325-- | Slice in chunks of size n and get the count of chunks.
326{-# INLINE chunksOf #-}
327chunksOf :: Int -> Handle -> IO Int
329 -- writeNUnsafe gives 2.5x boost here over writeN.
330 -- XXX replace with S.arraysOf
331 S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.read inh)
334inspect $ hasNoTypeClasses 'chunksOf
335inspect $ 'chunksOf `hasNoType` ''Step
336inspect $ 'chunksOf `hasNoType` ''GroupState
337inspect $ 'chunksOf `hasNoType` ''AT.ArrayUnsafe -- AT.writeNUnsafe
338inspect $ 'chunksOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
339inspect $ 'chunksOf `hasNoType` ''MA.ReadUState -- FH.read/A.read
342o_1_space_reduce_read_grouped :: BenchEnv -> [Benchmark]
343o_1_space_reduce_read_grouped env =
344 [ bgroup "reduce/read/chunks"
345 [ mkBench ("S.chunksOf " ++ show (bigSize env) ++ " FL.sum") env $
347 chunksOfSum (bigSize env) inh
348 , mkBench "S.chunksOf 1 FL.sum" env $ \inh _ ->
351 -- XXX investigate why we need inline/noinline in these cases (GHC)
352 -- Chunk using parsers
354 ("S.foldMany (FL.take " ++ show (bigSize env) ++ " FL.sum)")
356 $ \inh _ -> noinline foldManyChunksOfSum (bigSize env) inh
358 "S.foldMany (FL.take 1 FL.sum)"
360 $ \inh _ -> inline foldManyChunksOfSum 1 inh
362 ("S.parseMany (FL.take " ++ show (bigSize env) ++ " FL.sum)")
364 $ \inh _ -> noinline parseManyChunksOfSum (bigSize env) inh
366 "S.parseMany (FL.take 1 FL.sum)"
368 $ \inh _ -> inline parseManyChunksOfSum 1 inh
370 -- folding chunks to arrays
371 , mkBenchSmall "S.arraysOf 1" env $ \inh _ ->
373 , mkBench "S.arraysOf 10" env $ \inh _ ->
375 , mkBench "S.arraysOf 1000" env $ \inh _ ->
380allBenchmarks :: BenchEnv -> [Benchmark]
381allBenchmarks env = Prelude.concat
382 [ o_1_space_read_chunked env
383 , o_1_space_reduce_read env
384 , o_1_space_reduce_toBytes env
385 , 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