git.iko.soy/streamly
on a05abfc help sign in
streamly/benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs
301 lines 10 kB history raw
1-- |
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
7-- Portability : GHC
9{-# LANGUAGE CPP #-}
10{-# LANGUAGE ScopedTypeVariables #-}
12#ifdef __HADDOCK_VERSION__
13#undef INSPECTION
14#endif
16#ifdef INSPECTION
17{-# LANGUAGE TemplateHaskell #-}
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19#endif
21module Handle.Read
22 (allBenchmarks)
23where
25import Data.Word (Word8)
26import GHC.Magic (inline)
27#if __GLASGOW_HASKELL__ >= 802
28import GHC.Magic (noinline)
29#else
30#define noinline
31#endif
32import System.IO (Handle)
34import qualified Streamly.FileSystem.Handle as FH
35import qualified Streamly.Internal.Data.Array.Foreign as A
36import qualified Streamly.Internal.Data.Array.Foreign.Type as AT
37import qualified Streamly.Internal.Data.Fold as FL
38import qualified Streamly.Internal.Data.Stream.IsStream as IP
39import qualified Streamly.Internal.FileSystem.Handle as IFH
40import qualified Streamly.Internal.Unicode.Stream as IUS
41import qualified Streamly.Prelude as S
42import qualified Streamly.Unicode.Stream as SS
44import Gauge hiding (env)
45import Prelude hiding (last, length)
46import Streamly.Benchmark.Common.Handle
48#ifdef INSPECTION
49import Streamly.Internal.Data.Stream.StreamD.Type (Step(..), FoldMany)
51import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA
52import qualified Streamly.Internal.Data.Stream.StreamD as D
53import qualified Streamly.Internal.Data.Unfold as IUF
55import Test.Inspection
56#endif
58-- TBD reading with unfold
60-------------------------------------------------------------------------------
61-- unfold read
62-------------------------------------------------------------------------------
64-- | Get the last byte from a file bytestream.
65readLast :: Handle -> IO (Maybe Word8)
66readLast = S.last . S.unfold FH.read
68#ifdef INSPECTION
69inspect $ hasNoTypeClasses 'readLast
70inspect $ 'readLast `hasNoType` ''Step -- S.unfold
71inspect $ 'readLast `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
72inspect $ 'readLast `hasNoType` ''MA.ReadUState -- FH.read/A.read
73#endif
75-- assert that flattenArrays constructors are not present
76-- | Count the number of bytes in a file.
77readCountBytes :: Handle -> IO Int
78readCountBytes = S.length . S.unfold FH.read
80#ifdef INSPECTION
81inspect $ hasNoTypeClasses 'readCountBytes
82inspect $ 'readCountBytes `hasNoType` ''Step -- S.unfold
83inspect $ 'readCountBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
84inspect $ 'readCountBytes `hasNoType` ''MA.ReadUState -- FH.read/A.read
85#endif
87-- | Count the number of lines in a file.
88readCountLines :: Handle -> IO Int
89readCountLines =
90 S.length
91 . IUS.lines FL.drain
92 . SS.decodeLatin1
93 . S.unfold FH.read
95#ifdef INSPECTION
96inspect $ hasNoTypeClasses 'readCountLines
97inspect $ 'readCountLines `hasNoType` ''Step
98inspect $ 'readCountLines `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
99inspect $ 'readCountLines `hasNoType` ''MA.ReadUState -- FH.read/A.read
100#endif
102-- | Count the number of words in a file.
103readCountWords :: Handle -> IO Int
104readCountWords =
105 S.length
106 . IUS.words FL.drain
107 . SS.decodeLatin1
108 . S.unfold FH.read
110#ifdef INSPECTION
111inspect $ hasNoTypeClasses 'readCountWords
112-- inspect $ 'readCountWords `hasNoType` ''Step
113#endif
115-- | Sum the bytes in a file.
116readSumBytes :: Handle -> IO Word8
117readSumBytes = S.sum . S.unfold FH.read
119#ifdef INSPECTION
120inspect $ hasNoTypeClasses 'readSumBytes
121inspect $ 'readSumBytes `hasNoType` ''Step
122inspect $ 'readSumBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
123inspect $ 'readSumBytes `hasNoType` ''MA.ReadUState -- FH.read/A.read
124#endif
126-- XXX When we mark this with INLINE and we have two benchmarks using S.drain
127-- in one benchmark group then somehow GHC ends up delaying the inlining of
128-- readDrain. Since S.drain has an INLINE[2] for proper rule firing, that does
129-- not work well because of delyaed inlining and the code does not fuse. We
130-- need some way of propagating the inline phase information up so that we can
131-- expedite inlining of the callers too automatically. The minimal example for
132-- the problem can be created by using just two benchmarks in a bench group
133-- both using "readDrain". Either GHC should be fixed or we can use
134-- fusion-plugin to propagate INLINE phase information such that this problem
135-- does not occur.
136readDrain :: Handle -> IO ()
137readDrain inh = S.drain $ S.unfold FH.read inh
139-- XXX investigate why we need an INLINE in this case (GHC)
140{-# INLINE readDecodeLatin1 #-}
141readDecodeLatin1 :: Handle -> IO ()
142readDecodeLatin1 inh =
143 S.drain
144 $ SS.decodeLatin1
145 $ S.unfold FH.read inh
147readDecodeUtf8 :: Handle -> IO ()
148readDecodeUtf8 inh =
149 S.drain
150 $ SS.decodeUtf8
151 $ S.unfold FH.read inh
153#ifdef INSPECTION
154inspect $ hasNoTypeClasses 'readDecodeUtf8
155-- inspect $ 'readDecodeUtf8Lax `hasNoType` ''Step
156#endif
158o_1_space_reduce_read :: BenchEnv -> [Benchmark]
159o_1_space_reduce_read env =
160 [ bgroup "reduce/read"
161 [ -- read raw bytes without any decoding
162 mkBench "S.drain" env $ \inh _ ->
163 readDrain inh
164 , mkBench "S.last" env $ \inh _ ->
165 readLast inh
166 , mkBench "S.sum" env $ \inh _ ->
167 readSumBytes inh
169 -- read with Latin1 decoding
170 , mkBench "SS.decodeLatin1" env $ \inh _ ->
171 readDecodeLatin1 inh
172 , mkBench "S.length" env $ \inh _ ->
173 readCountBytes inh
174 , mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->
175 readCountLines inh
176 , mkBench "US.words . SS.decodeLatin1" env $ \inh _ ->
177 readCountWords inh
179 -- read with utf8 decoding
180 , mkBenchSmall "SS.decodeUtf8" env $ \inh _ ->
181 readDecodeUtf8 inh
182 ]
183 ]
185-------------------------------------------------------------------------------
186-- stream toBytes
187-------------------------------------------------------------------------------
189-- | Count the number of lines in a file.
190toChunksConcatUnfoldCountLines :: Handle -> IO Int
191toChunksConcatUnfoldCountLines inh =
192 S.length
193 $ IUS.lines FL.drain
194 $ SS.decodeLatin1
195 -- XXX replace with toBytes
196 $ S.unfoldMany A.read (IFH.toChunks inh)
198#ifdef INSPECTION
199inspect $ hasNoTypeClasses 'toChunksConcatUnfoldCountLines
200inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''Step
201inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''D.ConcatMapUState
202#endif
204o_1_space_reduce_toBytes :: BenchEnv -> [Benchmark]
205o_1_space_reduce_toBytes env =
206 [ bgroup "reduce/toBytes"
207 [ mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->
208 toChunksConcatUnfoldCountLines inh
209 ]
210 ]
212-------------------------------------------------------------------------------
213-- reduce after grouping in chunks
214-------------------------------------------------------------------------------
216chunksOfSum :: Int -> Handle -> IO Int
217chunksOfSum n inh = S.length $ S.chunksOf n FL.sum (S.unfold FH.read inh)
219foldManyPostChunksOfSum :: Int -> Handle -> IO Int
220foldManyPostChunksOfSum n inh =
221 S.length $ IP.foldManyPost (FL.take n FL.sum) (S.unfold FH.read inh)
223foldManyChunksOfSum :: Int -> Handle -> IO Int
224foldManyChunksOfSum n inh =
225 S.length $ IP.foldMany (FL.take n FL.sum) (S.unfold FH.read inh)
227-- XXX investigate why we need an INLINE in this case (GHC)
228-- Even though allocations remain the same in both cases inlining improves time
229-- by 4x.
230-- | Slice in chunks of size n and get the count of chunks.
231{-# INLINE chunksOf #-}
232chunksOf :: Int -> Handle -> IO Int
233chunksOf n inh =
234 -- writeNUnsafe gives 2.5x boost here over writeN.
235 S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.read inh)
237#ifdef INSPECTION
238inspect $ hasNoTypeClasses 'chunksOf
239inspect $ 'chunksOf `hasNoType` ''Step
240inspect $ 'chunksOf `hasNoType` ''FoldMany
241inspect $ 'chunksOf `hasNoType` ''AT.ArrayUnsafe -- AT.writeNUnsafe
242inspect $ 'chunksOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
243inspect $ 'chunksOf `hasNoType` ''MA.ReadUState -- FH.read/A.read
244#endif
246{-# INLINE arraysOf #-}
247arraysOf :: Int -> Handle -> IO Int
248arraysOf n inh = S.length $ IP.arraysOf n (S.unfold FH.read inh)
250o_1_space_reduce_read_grouped :: BenchEnv -> [Benchmark]
251o_1_space_reduce_read_grouped env =
252 [ bgroup "reduce/read/chunks"
253 [ mkBench ("S.chunksOf " ++ show (bigSize env) ++ " FL.sum") env $
254 \inh _ ->
255 chunksOfSum (bigSize env) inh
256 , mkBench "S.chunksOf 1 FL.sum" env $ \inh _ ->
257 chunksOfSum 1 inh
259 -- XXX investigate why we need inline/noinline in these cases (GHC)
260 -- Chunk using parsers
261 , mkBench
262 ("S.foldManyPost (FL.take " ++ show (bigSize env) ++ " FL.sum)")
263 env
264 $ \inh _ -> noinline foldManyPostChunksOfSum (bigSize env) inh
265 , mkBench
266 "S.foldManyPost (FL.take 1 FL.sum)"
267 env
268 $ \inh _ -> inline foldManyPostChunksOfSum 1 inh
269 , mkBench
270 ("S.foldMany (FL.take " ++ show (bigSize env) ++ " FL.sum)")
271 env
272 $ \inh _ -> noinline foldManyChunksOfSum (bigSize env) inh
273 , mkBench
274 "S.foldMany (FL.take 1 FL.sum)"
275 env
276 $ \inh _ -> inline foldManyChunksOfSum 1 inh
278 -- folding chunks to arrays
279 , mkBenchSmall "S.chunksOf 1" env $ \inh _ ->
280 chunksOf 1 inh
281 , mkBench "S.chunksOf 10" env $ \inh _ ->
282 chunksOf 10 inh
283 , mkBench "S.chunksOf 1000" env $ \inh _ ->
284 chunksOf 1000 inh
286 -- arraysOf may use a different impl than chunksOf
287 , mkBenchSmall "S.arraysOf 1" env $ \inh _ ->
288 arraysOf 1 inh
289 , mkBench "S.arraysOf 10" env $ \inh _ ->
290 arraysOf 10 inh
291 , mkBench "S.arraysOf 1000" env $ \inh _ ->
292 arraysOf 1000 inh
293 ]
294 ]
296allBenchmarks :: BenchEnv -> [Benchmark]
297allBenchmarks env = Prelude.concat
298 [ o_1_space_reduce_read env
299 , o_1_space_reduce_toBytes env
300 , o_1_space_reduce_read_grouped env
301 ]