benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs · streamly

git.iko.soy/streamly

on 3947fee help sign in

streamly/benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs

395 lines 13 kB history raw

1-- |

2-- Module : Streamly.Benchmark.FileSystem.Handle

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.Functor.Identity (runIdentity)

26import Data.Word (Word8)

27import GHC.Magic (inline)

28#if __GLASGOW_HASKELL__ >= 802

29import GHC.Magic (noinline)

30#else

31#define noinline

32#endif

33import System.IO (Handle)

35import qualified Streamly.FileSystem.Handle as FH

36import qualified Streamly.Internal.Data.Array.Foreign as A

37import qualified Streamly.Internal.Data.Array.Foreign.Types as AT

38import qualified Streamly.Internal.Data.Fold as FL

39import qualified Streamly.Internal.Data.Stream.IsStream as IP

40import qualified Streamly.Internal.FileSystem.Handle as IFH

41import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS

42import qualified Streamly.Internal.Unicode.Stream as IUS

43import qualified Streamly.Prelude as S

44import qualified Streamly.Unicode.Stream as SS

46import Gauge hiding (env)

47import Prelude hiding (last, length)

48import Streamly.Benchmark.Common.Handle

50#ifdef INSPECTION

51import Streamly.Internal.Data.Stream.StreamD.Type (Step(..), FoldMany)

53import qualified Streamly.Internal.Data.Array.Foreign.Mut.Types as MA

54import qualified Streamly.Internal.Data.Stream.StreamD as D

55import qualified Streamly.Internal.Data.Unfold as IUF

57import Test.Inspection

58#endif

60-------------------------------------------------------------------------------

61-- read chunked using toChunks

62-------------------------------------------------------------------------------

64-- | Get the last byte from a file bytestream.

65toChunksLast :: Handle -> IO (Maybe Word8)

66toChunksLast inh = do

67 let s = IFH.toChunks inh

68 larr <- S.last s

69 return $ case larr of

70 Nothing -> Nothing

71 Just arr -> A.readIndex arr (A.length arr - 1)

73#ifdef INSPECTION

74inspect $ hasNoTypeClasses 'toChunksLast

75inspect $ 'toChunksLast `hasNoType` ''Step

76#endif

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)

84#ifdef INSPECTION

85inspect $ hasNoTypeClasses 'toChunksSumLengths

86inspect $ 'toChunksSumLengths `hasNoType` ''Step

87#endif

89-- | Count the number of lines in a file.

90toChunksSplitOnSuffix :: Handle -> IO Int

91toChunksSplitOnSuffix = S.length . AS.splitOnSuffix 10 . IFH.toChunks

93#ifdef INSPECTION

94inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix

95inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step

96#endif

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

102

103#ifdef INSPECTION

104inspect $ hasNoTypeClasses 'toChunksSplitOn

105inspect $ 'toChunksSplitOn `hasNoType` ''Step

106#endif

107

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

114

115#ifdef INSPECTION

116inspect $ hasNoTypeClasses 'toChunksCountBytes

117inspect $ 'toChunksCountBytes `hasNoType` ''Step

118#endif

119

120toChunksDecodeUtf8Arrays :: Handle -> IO ()

121toChunksDecodeUtf8Arrays =

122 S.drain . IUS.decodeUtf8Arrays . IFH.toChunks

123

124#ifdef INSPECTION

125inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays

126-- inspect $ 'toChunksDecodeUtf8ArraysLenient `hasNoType` ''Step

127#endif

128

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 _ ->

134 toChunksLast 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 _ ->

143 toChunksSplitOn inH

144 , mkBench "countBytes" env $ \inH _ ->

145 toChunksCountBytes inH

146 , mkBenchSmall "US.decodeUtf8Arrays" env $ \inH _ ->

147 toChunksDecodeUtf8Arrays inH

148 ]

149 ]

150

151-- TBD reading with unfold

152

153-------------------------------------------------------------------------------

154-- unfold read

155-------------------------------------------------------------------------------

156

157-- | Get the last byte from a file bytestream.

158readLast :: Handle -> IO (Maybe Word8)

159readLast = S.last . S.unfold FH.read

160

161#ifdef INSPECTION

162inspect $ hasNoTypeClasses 'readLast

163inspect $ 'readLast `hasNoType` ''Step -- S.unfold

164inspect $ 'readLast `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat

165inspect $ 'readLast `hasNoType` ''MA.ReadUState -- FH.read/A.read

166#endif

167

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

172

173#ifdef INSPECTION

174inspect $ hasNoTypeClasses 'readCountBytes

175inspect $ 'readCountBytes `hasNoType` ''Step -- S.unfold

176inspect $ 'readCountBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat

177inspect $ 'readCountBytes `hasNoType` ''MA.ReadUState -- FH.read/A.read

178#endif

179

180-- | Count the number of lines in a file.

181readCountLines :: Handle -> IO Int

182readCountLines =

183 S.length

184 . IUS.lines FL.drain

185 . SS.decodeLatin1

186 . S.unfold FH.read

187

188#ifdef INSPECTION

189inspect $ hasNoTypeClasses 'readCountLines

190inspect $ 'readCountLines `hasNoType` ''Step

191inspect $ 'readCountLines `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat

192inspect $ 'readCountLines `hasNoType` ''MA.ReadUState -- FH.read/A.read

193#endif

194

195-- | Count the number of words in a file.

196readCountWords :: Handle -> IO Int

197readCountWords =

198 S.length

199 . IUS.words FL.drain

200 . SS.decodeLatin1

201 . S.unfold FH.read

202

203#ifdef INSPECTION

204inspect $ hasNoTypeClasses 'readCountWords

205-- inspect $ 'readCountWords `hasNoType` ''Step

206#endif

207

208-- | Sum the bytes in a file.

209readSumBytes :: Handle -> IO Word8

210readSumBytes = S.sum . S.unfold FH.read

211

212#ifdef INSPECTION

213inspect $ hasNoTypeClasses 'readSumBytes

214inspect $ 'readSumBytes `hasNoType` ''Step

215inspect $ 'readSumBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat

216inspect $ 'readSumBytes `hasNoType` ''MA.ReadUState -- FH.read/A.read

217#endif

218

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

228-- does not occur.

229readDrain :: Handle -> IO ()

230readDrain inh = S.drain $ S.unfold FH.read inh

231

232-- XXX investigate why we need an INLINE in this case (GHC)

233{-# INLINE readDecodeLatin1 #-}

234readDecodeLatin1 :: Handle -> IO ()

235readDecodeLatin1 inh =

236 S.drain

237 $ SS.decodeLatin1

238 $ S.unfold FH.read inh

239

240readDecodeUtf8 :: Handle -> IO ()

241readDecodeUtf8 inh =

242 S.drain

243 $ SS.decodeUtf8

244 $ S.unfold FH.read inh

245

246#ifdef INSPECTION

247inspect $ hasNoTypeClasses 'readDecodeUtf8

248-- inspect $ 'readDecodeUtf8Lax `hasNoType` ''Step

249#endif

250

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 _ ->

256 readDrain inh

257 , mkBench "S.last" env $ \inh _ ->

258 readLast inh

259 , mkBench "S.sum" env $ \inh _ ->

260 readSumBytes inh

261

262 -- read with Latin1 decoding

263 , mkBench "SS.decodeLatin1" env $ \inh _ ->

264 readDecodeLatin1 inh

265 , mkBench "S.length" env $ \inh _ ->

266 readCountBytes inh

267 , mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->

268 readCountLines inh

269 , mkBench "US.words . SS.decodeLatin1" env $ \inh _ ->

270 readCountWords inh

271

272 -- read with utf8 decoding

273 , mkBenchSmall "SS.decodeUtf8" env $ \inh _ ->

274 readDecodeUtf8 inh

275 ]

276 ]

277

278-------------------------------------------------------------------------------

279-- stream toBytes

280-------------------------------------------------------------------------------

281

282-- | Count the number of lines in a file.

283toChunksConcatUnfoldCountLines :: Handle -> IO Int

284toChunksConcatUnfoldCountLines inh =

285 S.length

286 $ IUS.lines FL.drain

287 $ SS.decodeLatin1

288 -- XXX replace with toBytes

289 $ S.concatUnfold A.read (IFH.toChunks inh)

290

291#ifdef INSPECTION

292inspect $ hasNoTypeClasses 'toChunksConcatUnfoldCountLines

293inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''Step

294inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''D.ConcatMapUState

295#endif

296

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

302 ]

303 ]

304

305-------------------------------------------------------------------------------

306-- reduce after grouping in chunks

307-------------------------------------------------------------------------------

308

309chunksOfSum :: Int -> Handle -> IO Int

310chunksOfSum n inh = S.length $ S.chunksOf n FL.sum (S.unfold FH.read inh)

311

312foldManyPostChunksOfSum :: Int -> Handle -> IO Int

313foldManyPostChunksOfSum n inh =

314 S.length $ IP.foldManyPost (FL.takeLE n FL.sum) (S.unfold FH.read inh)

315

316foldManyChunksOfSum :: Int -> Handle -> IO Int

317foldManyChunksOfSum n inh =

318 S.length $ IP.foldMany (FL.takeLE n FL.sum) (S.unfold FH.read inh)

319

320-- XXX investigate why we need an INLINE in this case (GHC)

321-- Even though allocations remain the same in both cases inlining improves time

322-- by 4x.

323-- | Slice in chunks of size n and get the count of chunks.

324{-# INLINE chunksOf #-}

325chunksOf :: Int -> Handle -> IO Int

326chunksOf n inh =

327 -- writeNUnsafe gives 2.5x boost here over writeN.

328 S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.read inh)

329

330#ifdef INSPECTION

331inspect $ hasNoTypeClasses 'chunksOf

332inspect $ 'chunksOf `hasNoType` ''Step

333inspect $ 'chunksOf `hasNoType` ''FoldMany

334inspect $ 'chunksOf `hasNoType` ''AT.ArrayUnsafe -- AT.writeNUnsafe

335inspect $ 'chunksOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat

336inspect $ 'chunksOf `hasNoType` ''MA.ReadUState -- FH.read/A.read

337#endif

338

339{-# INLINE arraysOf #-}

340arraysOf :: Int -> Handle -> IO Int

341arraysOf n inh = S.length $ IP.arraysOf n (S.unfold FH.read inh)

342

343o_1_space_reduce_read_grouped :: BenchEnv -> [Benchmark]

344o_1_space_reduce_read_grouped env =

345 [ bgroup "reduce/read/chunks"

346 [ mkBench ("S.chunksOf " ++ show (bigSize env) ++ " FL.sum") env $

347 \inh _ ->

348 chunksOfSum (bigSize env) inh

349 , mkBench "S.chunksOf 1 FL.sum" env $ \inh _ ->

350 chunksOfSum 1 inh

351

352 -- XXX investigate why we need inline/noinline in these cases (GHC)

353 -- Chunk using parsers

354 , mkBench

355 ("S.foldManyPost (FL.take " ++ show (bigSize env) ++ " FL.sum)")

356 env

357 $ \inh _ -> noinline foldManyPostChunksOfSum (bigSize env) inh

358 , mkBench

359 "S.foldManyPost (FL.take 1 FL.sum)"

360 env

361 $ \inh _ -> inline foldManyPostChunksOfSum 1 inh

362 , mkBench

363 ("S.foldMany (FL.take " ++ show (bigSize env) ++ " FL.sum)")

364 env

365 $ \inh _ -> noinline foldManyChunksOfSum (bigSize env) inh

366 , mkBench

367 "S.foldMany (FL.take 1 FL.sum)"

368 env

369 $ \inh _ -> inline foldManyChunksOfSum 1 inh

370

371 -- folding chunks to arrays

372 , mkBenchSmall "S.chunksOf 1" env $ \inh _ ->

373 chunksOf 1 inh

374 , mkBench "S.chunksOf 10" env $ \inh _ ->

375 chunksOf 10 inh

376 , mkBench "S.chunksOf 1000" env $ \inh _ ->

377 chunksOf 1000 inh

378

379 -- arraysOf may use a different impl than chunksOf

380 , mkBenchSmall "S.arraysOf 1" env $ \inh _ ->

381 arraysOf 1 inh

382 , mkBench "S.arraysOf 10" env $ \inh _ ->

383 arraysOf 10 inh

384 , mkBench "S.arraysOf 1000" env $ \inh _ ->

385 arraysOf 1000 inh

386 ]

387 ]

388

389allBenchmarks :: BenchEnv -> [Benchmark]

390allBenchmarks env = Prelude.concat

391 [ o_1_space_read_chunked env

392 , o_1_space_reduce_read env

393 , o_1_space_reduce_toBytes env

394 , o_1_space_reduce_read_grouped env

395 ]