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

git.iko.soy/streamly

on 0d58675 help sign in

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

1344 lines 48 kB history raw

1-- |

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

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

22import Control.DeepSeq (NFData(rnf))

23import Control.Exception (SomeException)

24import Data.Char (ord, chr)

25import Data.Functor.Identity (runIdentity)

26import Data.Word (Word8)

27#if __GLASGOW_HASKELL__ >= 800

28import System.Directory (getFileSize)

29#endif

30import System.Environment (lookupEnv)

31import System.IO (openFile, IOMode(..), Handle, hClose)

32import System.Process.Typed (shell, runProcess_)

33import Prelude hiding (last, length)

35import qualified Streamly.Data.Fold as FL

36import qualified Streamly.Data.Unicode.Stream as SS

37import qualified Streamly.FileSystem.Handle as FH

38-- import qualified Streamly.Internal.Data.Fold as IFL

39import qualified Streamly.Internal.Data.Parser as PR

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

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

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

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

44import qualified Streamly.Internal.Memory.Array as IA

45import qualified Streamly.Internal.Memory.Array.Types as AT

46import qualified Streamly.Internal.Memory.ArrayStream as AS

47import qualified Streamly.Internal.Memory.Unicode.Array as IUA

48import qualified Streamly.Internal.Prelude as IP

49import qualified Streamly.Memory.Array as A

50import qualified Streamly.Prelude as S

52import Data.IORef

53import Gauge hiding (env)

54import Streamly.Benchmark.Common

56#ifdef INSPECTION

57import Foreign.Storable (Storable)

58import Streamly.Internal.Data.Stream.StreamD.Type (Step(..), GroupState)

59import Test.Inspection

60#endif

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

63--

64-------------------------------------------------------------------------------

66moduleName :: String

67moduleName = "FileSystem.Handle"

69-------------------------------------------------------------------------------

70--

71-------------------------------------------------------------------------------

73scratchDir :: String

74scratchDir = "benchmark-tmp"

76outfile :: String

77outfile = scratchDir ++ "out.txt"

79smallFileSize :: Int

80smallFileSize = 10 * 1024 * 1024

82inFileSmall :: String

83inFileSmall = scratchDir ++ "in-10MB.txt"

85bigFileSize :: Int

86bigFileSize = 100 * 1024 * 1024

88inFileBig :: String

89inFileBig = scratchDir ++ "in-100MB.txt"

91blockSize :: Int

92blockSize = 32768

94blockCount :: Int -> Int

95blockCount size = (size + blockSize - 1) `div` blockSize

97data RefHandles = RefHandles

98 { smallInH :: Handle

99 , bigInH :: Handle

100 , outputH :: Handle

101 }

102

103data Handles = Handles !Handle !Handle

104

105instance NFData Handles where

106 rnf _ = ()

107

108data BenchEnv = BenchEnv

109 { href :: IORef RefHandles

110 , smallSize :: Int

111 , bigSize :: Int

112 , nullH :: Handle

113 }

114

115withScaling :: BenchEnv -> String -> String

116withScaling env str =

117 let factor = round (fromIntegral (bigSize env)

118 / (fromIntegral (smallSize env) :: Double)) :: Int

119 in if factor == 1

120 then str

121 else str ++ " (1/" ++ show factor ++ ")"

122

123mkBenchCommon ::

124 NFData b

125 => (RefHandles -> Handles)

126 -> String

127 -> BenchEnv

128 -> (Handle -> Handle -> IO b)

129 -> Benchmark

130mkBenchCommon mkHandles name env action =

131 bench name $ perRunEnv (do

132 r <- readIORef $ href env

133

134 -- close old handles

135 hClose $ smallInH r

136 hClose $ bigInH r

137 hClose $ outputH r

138

139 -- reopen

140 smallInHandle <- openFile inFileSmall ReadMode

141 bigInHandle <- openFile inFileBig ReadMode

142 outHandle <- openFile outfile WriteMode

143

144 let refHandles = RefHandles

145 { smallInH = smallInHandle

146 , bigInH = bigInHandle

147 , outputH = outHandle

148 }

149

150 -- update

151 writeIORef (href env) $ refHandles

152 return $ mkHandles refHandles

153 )

154 (\(Handles h1 h2) -> action h1 h2)

155

156mkBench ::

157 NFData b => String -> BenchEnv -> (Handle -> Handle -> IO b) -> Benchmark

158mkBench name env action = mkBenchCommon useBigH name env action

159

160 where

161

162 useBigH (RefHandles {bigInH = inh, outputH = outh}) = Handles inh outh

163

164mkBenchSmall ::

165 NFData b => String -> BenchEnv -> (Handle -> Handle -> IO b) -> Benchmark

166mkBenchSmall name env action =

167 mkBenchCommon useSmallH (withScaling env name) env action

168

169 where

170

171 useSmallH (RefHandles {smallInH = inh, outputH = outh}) = Handles inh outh

172

173-------------------------------------------------------------------------------

174-- read chunked using toChunks

175-------------------------------------------------------------------------------

176

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

178{-# INLINE toChunksLast #-}

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

180toChunksLast inh = do

181 let s = IFH.toChunks inh

182 larr <- S.last s

183 return $ case larr of

184 Nothing -> Nothing

185 Just arr -> IA.readIndex arr (A.length arr - 1)

186

187#ifdef INSPECTION

188inspect $ hasNoTypeClasses 'toChunksLast

189inspect $ 'toChunksLast `hasNoType` ''Step

190#endif

191

192-- | Count the number of bytes in a file.

193{-# INLINE toChunksSumLengths #-}

194toChunksSumLengths :: Handle -> IO Int

195toChunksSumLengths inh =

196 let s = IFH.toChunks inh

197 in S.sum (S.map A.length s)

198

199#ifdef INSPECTION

200inspect $ hasNoTypeClasses 'toChunksSumLengths

201inspect $ 'toChunksSumLengths `hasNoType` ''Step

202#endif

203

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

205{-# INLINE toChunksSplitOnSuffix #-}

206toChunksSplitOnSuffix :: Handle -> IO Int

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

208

209#ifdef INSPECTION

210inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix

211inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step

212#endif

213

214-- XXX use a word splitting combinator instead of splitOn and test it.

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

216{-# INLINE toChunksSplitOn #-}

217toChunksSplitOn :: Handle -> IO Int

218toChunksSplitOn = S.length . AS.splitOn 32 . IFH.toChunks

219

220#ifdef INSPECTION

221inspect $ hasNoTypeClasses 'toChunksSplitOn

222inspect $ 'toChunksSplitOn `hasNoType` ''Step

223#endif

224

225-- | Sum the bytes in a file.

226{-# INLINE toChunksCountBytes #-}

227toChunksCountBytes :: Handle -> IO Word8

228toChunksCountBytes inh = do

229 let foldlArr' f z = runIdentity . S.foldl' f z . IA.toStream

230 let s = IFH.toChunks inh

231 S.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s

232

233#ifdef INSPECTION

234inspect $ hasNoTypeClasses 'toChunksCountBytes

235inspect $ 'toChunksCountBytes `hasNoType` ''Step

236#endif

237

238{-# INLINE toChunksWithBufferOfDecodeUtf8ArraysLenient #-}

239toChunksWithBufferOfDecodeUtf8ArraysLenient :: Handle -> IO ()

240toChunksWithBufferOfDecodeUtf8ArraysLenient inh =

241 S.drain

242 $ IUS.decodeUtf8ArraysLenient

243 $ IFH.toChunksWithBufferOf (1024*1024) inh

244

245#ifdef INSPECTION

246inspect $ hasNoTypeClasses 'decodeUtf8Lenient

247-- inspect $ 'decodeUtf8Lenient `hasNoType` ''Step

248-- inspect $ 'decodeUtf8Lenient `hasNoType` ''AT.FlattenState

249-- inspect $ 'decodeUtf8Lenient `hasNoType` ''D.ConcatMapUState

250#endif

251

252o_1_space_read_chunked :: BenchEnv -> [Benchmark]

253o_1_space_read_chunked env =

254 -- read using toChunks instead of read

255 [ bgroup "reduce/toChunks"

256 [ mkBench "S.last (32K)" env $ \inH _ ->

257 toChunksLast inH

258 -- Note: this cannot be fairly compared with GNU wc -c or wc -m as

259 -- wc uses lseek to just determine the file size rather than reading

260 -- and counting characters.

261 , mkBench "S.sum . S.map A.length (32K)" env $ \inH _ ->

262 toChunksSumLengths inH

263 , mkBench "AS.splitOnSuffix (32K)" env $ \inH _ ->

264 toChunksSplitOnSuffix inH

265 , mkBench "AS.splitOn (32K)" env $ \inH _ ->

266 toChunksSplitOn inH

267 , mkBench "countBytes (32K)" env $ \inH _ ->

268 toChunksCountBytes inH

269 , mkBenchSmall "US.decodeUtf8ArraysLenient (1MB)" env $ \inH _ ->

270 toChunksWithBufferOfDecodeUtf8ArraysLenient inH

271 ]

272 ]

273

274-- TBD reading with unfold

275

276-------------------------------------------------------------------------------

277-- copy chunked

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

279

280-- | Send the file contents to /dev/null

281{-# INLINE toChunksWithBufferOf #-}

282toChunksWithBufferOf :: Handle -> Handle -> IO ()

283toChunksWithBufferOf inh devNull =

284 S.fold (IFH.writeChunks devNull) $ IFH.toChunksWithBufferOf (256*1024) inh

285

286#ifdef INSPECTION

287inspect $ hasNoTypeClasses 'toChunksWithBufferOf

288inspect $ 'toChunksWithBufferOf `hasNoType` ''Step

289#endif

290

291-- | Copy file

292{-# INLINE copyChunks #-}

293copyChunks :: Handle -> Handle -> IO ()

294copyChunks inh outh =

295 let s = IFH.toChunks inh

296 in S.fold (IFH.writeChunks outh) s

297

298#ifdef INSPECTION

299inspect $ hasNoTypeClasses 'toChunksWriteChunks

300inspect $ 'toChunksWriteChunks `hasNoType` ''Step

301#endif

302

303-- | Copy file

304{-# INLINE copyCodecUtf8ArraysLenient #-}

305copyCodecUtf8ArraysLenient :: Handle -> Handle -> IO ()

306copyCodecUtf8ArraysLenient inh outh =

307 S.fold (FH.write outh)

308 $ SS.encodeUtf8

309 $ IUS.decodeUtf8ArraysLenient

310 $ IFH.toChunksWithBufferOf (1024*1024) inh

311

312#ifdef INSPECTION

313inspect $ hasNoTypeClasses 'copyCodecUtf8ArraysLenient

314-- inspect $ 'copyCodecUtf8ArraysLenient `hasNoType` ''Step

315-- inspect $ 'copyCodecUtf8ArraysLenient `hasNoType` ''AT.FlattenState

316-- inspect $ 'copyCodecUtf8ArraysLenient `hasNoType` ''D.ConcatMapUState

317#endif

318

319o_1_space_copy_chunked :: BenchEnv -> [Benchmark]

320o_1_space_copy_chunked env =

321 [ bgroup "copy/toChunks"

322 [ mkBench "toNull (256K)" env $ \inH _ ->

323 toChunksWithBufferOf inH (nullH env)

324 , mkBench "raw" env $ \inH outH ->

325 copyChunks inH outH

326 , mkBenchSmall "decodeEncodeUtf8Lenient" env $ \inH outH ->

327 copyCodecUtf8ArraysLenient inH outH

328 ]

329 ]

330

331-- TBD reading with unfold

332

333-------------------------------------------------------------------------------

334-- Exceptions readChunks

335-------------------------------------------------------------------------------

336

337-- | Send the file contents to /dev/null with exception handling

338{-# INLINE readChunksWithBufferOfOnExceptionUnfold #-}

339readChunksWithBufferOfOnExceptionUnfold :: Handle -> Handle -> IO ()

340readChunksWithBufferOfOnExceptionUnfold inh devNull =

341 let readEx = IUF.onException (\_ -> hClose inh)

342 (IUF.supplyFirst FH.readChunksWithBufferOf (256*1024))

343 in IUF.fold readEx (IFH.writeChunks devNull) inh

344

345#ifdef INSPECTION

346inspect $ hasNoTypeClasses 'readChunksWithBufferOfOnExceptionUnfold

347-- inspect $ 'readChunksWithBufferOfOnExceptionUnfold `hasNoType` ''Step

348#endif

349

350-- | Send the file contents to /dev/null with exception handling

351{-# INLINE readChunksWithBufferOfBracketUnfold #-}

352readChunksWithBufferOfBracketUnfold :: Handle -> Handle -> IO ()

353readChunksWithBufferOfBracketUnfold inh devNull =

354 let readEx = IUF.bracket return (\_ -> hClose inh)

355 (IUF.supplyFirst FH.readChunksWithBufferOf (256*1024))

356 in IUF.fold readEx (IFH.writeChunks devNull) inh

357

358#ifdef INSPECTION

359inspect $ hasNoTypeClasses 'readChunksWithBufferOfBracketUnfold

360-- inspect $ 'readChunksWithBufferOfBracketUnfold `hasNoType` ''Step

361#endif

362

363{-# INLINE readChunksWithBufferOfBracketIOUnfold #-}

364readChunksWithBufferOfBracketIOUnfold :: Handle -> Handle -> IO ()

365readChunksWithBufferOfBracketIOUnfold inh devNull =

366 let readEx = IUF.bracketIO return (\_ -> hClose inh)

367 (IUF.supplyFirst FH.readChunksWithBufferOf (256*1024))

368 in IUF.fold readEx (IFH.writeChunks devNull) inh

369

370o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark]

371o_1_space_copy_exceptions_readChunks env =

372 [ bgroup "copy/exceptions/unfold/readChunks"

373 [ mkBench "onException (256K)" env $ \inH _ ->

374 readChunksWithBufferOfOnExceptionUnfold inH (nullH env)

375 , mkBench "bracket (256K)" env $ \inH _ ->

376 readChunksWithBufferOfBracketUnfold inH (nullH env)

377 , mkBench "bracketIO (256K)" env $ \inH _ ->

378 readChunksWithBufferOfBracketIOUnfold inH (nullH env)

379 ]

380 ]

381

382-------------------------------------------------------------------------------

383-- Exceptions toChunks

384-------------------------------------------------------------------------------

385

386-- | Send the file contents to /dev/null with exception handling

387{-# INLINE toChunksWithBufferOfBracketStream #-}

388toChunksWithBufferOfBracketStream :: Handle -> Handle -> IO ()

389toChunksWithBufferOfBracketStream inh devNull =

390 let readEx = S.bracket (return ()) (\_ -> hClose inh)

391 (\_ -> IFH.toChunksWithBufferOf (256*1024) inh)

392 in S.fold (IFH.writeChunks devNull) $ readEx

393

394#ifdef INSPECTION

395inspect $ hasNoTypeClasses 'toChunksWithBufferOfBracketStream

396-- inspect $ 'toChunksWithBufferOfBracketStream `hasNoType` ''Step

397#endif

398

399{-# INLINE toChunksWithBufferOfBracketIOStream #-}

400toChunksWithBufferOfBracketIOStream :: Handle -> Handle -> IO ()

401toChunksWithBufferOfBracketIOStream inh devNull =

402 let readEx = IP.bracketIO (return ()) (\_ -> hClose inh)

403 (\_ -> IFH.toChunksWithBufferOf (256*1024) inh)

404 in S.fold (IFH.writeChunks devNull) $ readEx

405

406o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]

407o_1_space_copy_exceptions_toChunks env =

408 [ bgroup "copy/exceptions/stream/toChunks"

409 [ mkBench "bracket (256K)" env $ \inH _ ->

410 toChunksWithBufferOfBracketStream inH (nullH env)

411 , mkBench "bracketIO (256K)" env $ \inH _ ->

412 toChunksWithBufferOfBracketIOStream inH (nullH env)

413 ]

414 ]

415

416-------------------------------------------------------------------------------

417-- unfold read

418-------------------------------------------------------------------------------

419

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

421{-# INLINE readLast #-}

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

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

424

425#ifdef INSPECTION

426inspect $ hasNoTypeClasses 'readLast

427inspect $ 'readLast `hasNoType` ''Step

428inspect $ 'readLast `hasNoType` ''AT.FlattenState

429inspect $ 'readLast `hasNoType` ''D.ConcatMapUState

430#endif

431

432-- assert that flattenArrays constructors are not present

433-- | Count the number of bytes in a file.

434{-# INLINE readCountBytes #-}

435readCountBytes :: Handle -> IO Int

436readCountBytes = S.length . S.unfold FH.read

437

438#ifdef INSPECTION

439inspect $ hasNoTypeClasses 'countBytes

440inspect $ 'countBytes `hasNoType` ''Step

441inspect $ 'countBytes `hasNoType` ''AT.FlattenState

442inspect $ 'countBytes `hasNoType` ''D.ConcatMapUState

443#endif

444

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

446{-# INLINE readCountLines #-}

447readCountLines :: Handle -> IO Int

448readCountLines =

449 S.length

450 . IUS.lines FL.drain

451 . SS.decodeLatin1

452 . S.unfold FH.read

453

454#ifdef INSPECTION

455inspect $ hasNoTypeClasses 'readCountLines

456inspect $ 'readCountLines `hasNoType` ''Step

457inspect $ 'readCountLines `hasNoType` ''AT.FlattenState

458inspect $ 'readCountLines `hasNoType` ''D.ConcatMapUState

459#endif

460

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

462{-# INLINE readCountWords #-}

463readCountWords :: Handle -> IO Int

464readCountWords =

465 S.length

466 . IUS.words FL.drain

467 . SS.decodeLatin1

468 . S.unfold FH.read

469

470#ifdef INSPECTION

471inspect $ hasNoTypeClasses 'readCountWords

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

473-- inspect $ 'readCountWords `hasNoType` ''D.ConcatMapUState

474#endif

475

476-- | Sum the bytes in a file.

477{-# INLINE readSumBytes #-}

478readSumBytes :: Handle -> IO Word8

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

480

481#ifdef INSPECTION

482inspect $ hasNoTypeClasses 'readSumBytes

483inspect $ 'readSumBytes `hasNoType` ''Step

484inspect $ 'readSumBytes `hasNoType` ''AT.FlattenState

485inspect $ 'readSumBytes `hasNoType` ''D.ConcatMapUState

486#endif

487

488-- XXX If we have two benchmarks using S.drain in one benchmark group then

489-- somehow GHC ends up delaying the inlining of readDrain. since S.drain has an

490-- INLINE[2] for proper rule firing, that does not work well because of delyaed

491-- inlining and the code does not fuse. We need some way of propagating the

492-- inline phase information up so that we can expedite inlining of the callers

493-- too automatically. The minimal example for the problem can be created by

494-- using just two benchmarks in a bench group both using "readDrain".

495{-# INLINE[2] readDrain #-}

496readDrain :: Handle -> IO ()

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

498

499{-# INLINE[2] readDecodeLatin1 #-}

500readDecodeLatin1 :: Handle -> IO ()

501readDecodeLatin1 inh =

502 S.drain

503 $ SS.decodeLatin1

504 $ S.unfold FH.read inh

505

506{-# INLINE[2] readDecodeUtf8Lax #-}

507readDecodeUtf8Lax :: Handle -> IO ()

508readDecodeUtf8Lax inh =

509 S.drain

510 $ SS.decodeUtf8Lax

511 $ S.unfold FH.read inh

512

513#ifdef INSPECTION

514inspect $ hasNoTypeClasses 'readDecodeUtf8Lax

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

516-- inspect $ 'readDecodeUtf8Lax `hasNoType` ''AT.FlattenState

517-- inspect $ 'readDecodeUtf8Lax `hasNoType` ''D.ConcatMapUState

518#endif

519

520o_1_space_reduce_read :: BenchEnv -> [Benchmark]

521o_1_space_reduce_read env =

522 [ bgroup "reduce/read"

523 [ -- read raw bytes without any decoding

524 mkBench "S.drain" env $ \inh _ ->

525 readDrain inh

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

527 readLast inh

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

529 readSumBytes inh

530

531 -- read with Latin1 decoding

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

533 readDecodeLatin1 inh

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

535 readCountBytes inh

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

537 readCountLines inh

538 , mkBenchSmall "US.words . SS.decodeLatin1" env $ \inh _ ->

539 readCountWords inh

540

541 -- read with utf8 decoding

542 , mkBenchSmall "SS.decodeUtf8Lax" env $ \inh _ ->

543 readDecodeUtf8Lax inh

544 ]

545 ]

546

547-------------------------------------------------------------------------------

548-- stream toBytes

549-------------------------------------------------------------------------------

550

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

552{-# INLINE toChunksConcatUnfoldCountLines #-}

553toChunksConcatUnfoldCountLines :: Handle -> IO Int

554toChunksConcatUnfoldCountLines inh =

555 S.length

556 $ IUS.lines FL.drain

557 $ SS.decodeLatin1

558 -- XXX replace with toBytes

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

560

561#ifdef INSPECTION

562inspect $ hasNoTypeClasses 'countLinesU

563inspect $ 'countLinesU `hasNoType` ''Step

564inspect $ 'countLinesU `hasNoType` ''D.ConcatMapUState

565#endif

566

567o_1_space_reduce_toBytes :: BenchEnv -> [Benchmark]

568o_1_space_reduce_toBytes env =

569 [ bgroup "reduce/toBytes"

570 [ mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->

571 toChunksConcatUnfoldCountLines inh

572 ]

573 ]

574

575-------------------------------------------------------------------------------

576-- reduce after grouping in chunks

577-------------------------------------------------------------------------------

578

579{-# INLINE chunksOfSum #-}

580chunksOfSum :: Int -> Handle -> IO Int

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

582

583{-# INLINE parseManyChunksOfSum #-}

584parseManyChunksOfSum :: Int -> Handle -> IO Int

585parseManyChunksOfSum n inh =

586 S.length $ IP.parseMany (PR.take n FL.sum) (S.unfold FH.read inh)

587

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

589{-# INLINE chunksOf #-}

590chunksOf :: Int -> Handle -> IO Int

591chunksOf n inh =

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

593 -- XXX replace with S.arraysOf

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

595

596#ifdef INSPECTION

597inspect $ hasNoTypeClasses 'chunksOf

598inspect $ 'chunksOf `hasNoType` ''Step

599inspect $ 'chunksOf `hasNoType` ''AT.FlattenState

600inspect $ 'chunksOf `hasNoType` ''D.ConcatMapUState

601inspect $ 'chunksOf `hasNoType` ''GroupState

602#endif

603

604-- This is to make sure that the concatMap in FH.read, groupsOf and foldlM'

605-- together can fuse.

606--

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

608{-# INLINE _chunksOfD #-}

609_chunksOfD :: Int -> Handle -> IO Int

610_chunksOfD n inh =

611 D.foldlM' (\i _ -> return $ i + 1) (return 0)

612 $ D.groupsOf n (AT.writeNUnsafe n)

613 $ D.fromStreamK (S.unfold FH.read inh)

614

615#ifdef INSPECTION

616inspect $ hasNoTypeClasses '_chunksOfD

617inspect $ '_chunksOfD `hasNoType` ''Step

618inspect $ '_chunksOfD `hasNoType` ''GroupState

619inspect $ '_chunksOfD `hasNoType` ''AT.FlattenState

620inspect $ '_chunksOfD `hasNoType` ''D.ConcatMapUState

621#endif

622

623o_1_space_reduce_read_grouped :: BenchEnv -> [Benchmark]

624o_1_space_reduce_read_grouped env =

625 [ bgroup "reduce/read/chunks"

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

627 \inh _ ->

628 chunksOfSum (bigSize env) inh

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

630 chunksOfSum 1 inh

631

632 -- Chunk using parsers

633 , mkBenchSmall ("S.parseMany (PR.take " ++ show (bigSize env) ++ " FL.sum)")

634 env $ \inh _ ->

635 parseManyChunksOfSum (bigSize env) inh

636 , mkBench "S.parseMany (PR.take 1 FL.sum)" env $ \inh _ ->

637 parseManyChunksOfSum 1 inh

638

639 -- folding chunks to arrays

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

641 chunksOf 1 inh

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

643 chunksOf 10 inh

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

645 chunksOf 1000 inh

646 ]

647 ]

648

649-------------------------------------------------------------------------------

650-- copy unfold

651-------------------------------------------------------------------------------

652

653-- | Send the file contents to /dev/null

654{-# INLINE readWriteNull #-}

655readWriteNull :: Handle -> Handle -> IO ()

656readWriteNull inh devNull = S.fold (FH.write devNull) $ S.unfold FH.read inh

657

658#ifdef INSPECTION

659inspect $ hasNoTypeClasses 'readWriteNull

660inspect $ 'readWriteNull `hasNoType` ''Step

661inspect $ 'readWriteNull `hasNoType` ''AT.FlattenState

662inspect $ 'readWriteNull `hasNoType` ''D.ConcatMapUState

663#endif

664

665-- | Copy file

666{-# INLINE copyStream #-}

667copyStream :: Handle -> Handle -> IO ()

668copyStream inh outh = S.fold (FH.write outh) (S.unfold FH.read inh)

669

670#ifdef INSPECTION

671inspect $ hasNoTypeClasses 'copyStream

672inspect $ 'copyStream `hasNoType` ''Step

673inspect $ 'copyStream `hasNoType` ''AT.FlattenState

674inspect $ 'copyStream `hasNoType` ''D.ConcatMapUState

675#endif

676

677-- | Copy file

678{-# INLINE copyStreamLatin1 #-}

679copyStreamLatin1 :: Handle -> Handle -> IO ()

680copyStreamLatin1 inh outh =

681 S.fold (FH.write outh)

682 $ SS.encodeLatin1

683 $ SS.decodeLatin1

684 $ S.unfold FH.read inh

685

686#ifdef INSPECTION

687inspect $ hasNoTypeClasses 'copyStreamLatin1

688inspect $ 'copyStreamLatin1 `hasNoType` ''Step

689inspect $ 'copyStreamLatin1 `hasNoType` ''AT.FlattenState

690inspect $ 'copyStreamLatin1 `hasNoType` ''D.ConcatMapUState

691#endif

692

693-- | Copy file

694{-# INLINE _copyStreamUtf8 #-}

695_copyStreamUtf8 :: Handle -> Handle -> IO ()

696_copyStreamUtf8 inh outh =

697 S.fold (FH.write outh)

698 $ SS.encodeUtf8

699 $ SS.decodeUtf8

700 $ S.unfold FH.read inh

701

702#ifdef INSPECTION

703inspect $ hasNoTypeClasses '_copyStreamUtf8

704-- inspect $ '_copyStreamUtf8 `hasNoType` ''Step

705-- inspect $ '_copyStreamUtf8 `hasNoType` ''AT.FlattenState

706-- inspect $ '_copyStreamUtf8 `hasNoType` ''D.ConcatMapUState

707#endif

708

709-- | Copy file

710{-# INLINE copyStreamUtf8Lax #-}

711copyStreamUtf8Lax :: Handle -> Handle -> IO ()

712copyStreamUtf8Lax inh outh =

713 S.fold (FH.write outh)

714 $ SS.encodeUtf8

715 $ SS.decodeUtf8Lax

716 $ S.unfold FH.read inh

717

718#ifdef INSPECTION

719inspect $ hasNoTypeClasses 'copyStreamUtf8Lax

720-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''Step

721-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''AT.FlattenState

722-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''D.ConcatMapUState

723#endif

724

725o_1_space_copy_read :: BenchEnv -> [Benchmark]

726o_1_space_copy_read env =

727 [ bgroup "copy/read"

728 [ mkBench "rawToNull" env $ \inh _ ->

729 readWriteNull inh (nullH env)

730 , mkBench "rawToFile" env $ \inh outh ->

731 copyStream inh outh

732 -- This needs an ascii file, as decode just errors out.

733 , mkBench "SS.encodeLatin1 . SS.decodeLatin1" env $ \inh outh ->

734 copyStreamLatin1 inh outh

735#ifdef DEVBUILD

736 , mkBench "copyUtf8" env $ \inh outh ->

737 _copyStreamUtf8 inh outh

738#endif

739 , mkBenchSmall "SS.encodeUtf8 . SS.decodeUtf8Lax" env $ \inh outh ->

740 copyStreamUtf8Lax inh outh

741 ]

742 ]

743

744-------------------------------------------------------------------------------

745-- copy stream

746-------------------------------------------------------------------------------

747

748-- | Send the file contents to /dev/null

749{-# INLINE readFromBytesNull #-}

750readFromBytesNull :: Handle -> Handle -> IO ()

751readFromBytesNull inh devNull = IFH.fromBytes devNull $ S.unfold FH.read inh

752

753#ifdef INSPECTION

754inspect $ hasNoTypeClasses 'catStreamWrite

755inspect $ 'catStreamWrite `hasNoType` ''Step

756inspect $ 'catStreamWrite `hasNoType` ''AT.FlattenState

757inspect $ 'catStreamWrite `hasNoType` ''D.ConcatMapUState

758#endif

759

760o_1_space_copy_fromBytes :: BenchEnv -> [Benchmark]

761o_1_space_copy_fromBytes env =

762 [ bgroup "copy/fromBytes"

763 [ mkBench "rawToNull" env $ \inh _ ->

764 readFromBytesNull inh (nullH env)

765 ]

766 ]

767

768-------------------------------------------------------------------------------

769-- unfold exceptions

770-------------------------------------------------------------------------------

771

772-- | Send the file contents to /dev/null with exception handling

773{-# INLINE readWriteOnExceptionUnfold #-}

774readWriteOnExceptionUnfold :: Handle -> Handle -> IO ()

775readWriteOnExceptionUnfold inh devNull =

776 let readEx = IUF.onException (\_ -> hClose inh) FH.read

777 in S.fold (FH.write devNull) $ S.unfold readEx inh

778

779#ifdef INSPECTION

780inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold

781-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''Step

782-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''AT.FlattenState

783-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''D.ConcatMapUState

784#endif

785

786-- | Send the file contents to /dev/null with exception handling

787{-# INLINE readWriteHandleExceptionUnfold #-}

788readWriteHandleExceptionUnfold :: Handle -> Handle -> IO ()

789readWriteHandleExceptionUnfold inh devNull =

790 let handler (_e :: SomeException) = hClose inh >> return 10

791 readEx = IUF.handle (IUF.singletonM handler) FH.read

792 in S.fold (FH.write devNull) $ S.unfold readEx inh

793

794#ifdef INSPECTION

795inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold

796-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''Step

797-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''AT.FlattenState

798-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''D.ConcatMapUState

799#endif

800

801-- | Send the file contents to /dev/null with exception handling

802{-# INLINE readWriteFinallyUnfold #-}

803readWriteFinallyUnfold :: Handle -> Handle -> IO ()

804readWriteFinallyUnfold inh devNull =

805 let readEx = IUF.finally (\_ -> hClose inh) FH.read

806 in S.fold (FH.write devNull) $ S.unfold readEx inh

807

808#ifdef INSPECTION

809inspect $ hasNoTypeClasses 'readWriteFinallyUnfold

810-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''Step

811-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''AT.FlattenState

812-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''D.ConcatMapUState

813#endif

814

815{-# INLINE readWriteFinallyIOUnfold #-}

816readWriteFinallyIOUnfold :: Handle -> Handle -> IO ()

817readWriteFinallyIOUnfold inh devNull =

818 let readEx = IUF.finallyIO (\_ -> hClose inh) FH.read

819 in S.fold (FH.write devNull) $ S.unfold readEx inh

820

821-- | Send the file contents to /dev/null with exception handling

822{-# INLINE readWriteBracketUnfold #-}

823readWriteBracketUnfold :: Handle -> Handle -> IO ()

824readWriteBracketUnfold inh devNull =

825 let readEx = IUF.bracket return (\_ -> hClose inh) FH.read

826 in S.fold (FH.write devNull) $ S.unfold readEx inh

827

828#ifdef INSPECTION

829inspect $ hasNoTypeClasses 'readWriteBracketUnfold

830-- inspect $ 'readWriteBracketUnfold `hasNoType` ''Step

831-- inspect $ 'readWriteBracketUnfold `hasNoType` ''AT.FlattenState

832-- inspect $ 'readWriteBracketUnfold `hasNoType` ''D.ConcatMapUState

833#endif

834

835{-# INLINE readWriteBracketIOUnfold #-}

836readWriteBracketIOUnfold :: Handle -> Handle -> IO ()

837readWriteBracketIOUnfold inh devNull =

838 let readEx = IUF.bracketIO return (\_ -> hClose inh) FH.read

839 in S.fold (FH.write devNull) $ S.unfold readEx inh

840

841o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark]

842o_1_space_copy_read_exceptions env =

843 [ bgroup "copy/read/exceptions"

844 [ mkBenchSmall "UF.onException" env $ \inh _ ->

845 readWriteOnExceptionUnfold inh (nullH env)

846 , mkBenchSmall "UF.handle" env $ \inh _ ->

847 readWriteHandleExceptionUnfold inh (nullH env)

848 , mkBenchSmall "UF.finally" env $ \inh _ ->

849 readWriteFinallyUnfold inh (nullH env)

850 , mkBenchSmall "UF.finallyIO" env $ \inh _ ->

851 readWriteFinallyIOUnfold inh (nullH env)

852 , mkBenchSmall "UF.bracket" env $ \inh _ ->

853 readWriteBracketUnfold inh (nullH env)

854 , mkBenchSmall "UF.bracketIO" env $ \inh _ ->

855 readWriteBracketIOUnfold inh (nullH env)

856 ]

857 ]

858

859-------------------------------------------------------------------------------

860-- stream exceptions

861-------------------------------------------------------------------------------

862

863-- | Send the file contents to /dev/null with exception handling

864{-# INLINE readWriteOnExceptionStream #-}

865readWriteOnExceptionStream :: Handle -> Handle -> IO ()

866readWriteOnExceptionStream inh devNull =

867 let readEx = S.onException (hClose inh) (S.unfold FH.read inh)

868 in S.fold (FH.write devNull) $ readEx

869

870-- | Send the file contents to /dev/null with exception handling

871{-# INLINE readWriteHandleExceptionStream #-}

872readWriteHandleExceptionStream :: Handle -> Handle -> IO ()

873readWriteHandleExceptionStream inh devNull =

874 let handler (_e :: SomeException) = S.yieldM (hClose inh >> return 10)

875 readEx = S.handle handler (S.unfold FH.read inh)

876 in S.fold (FH.write devNull) $ readEx

877

878-- | Send the file contents to /dev/null with exception handling

879{-# INLINE readWriteFinallyStream #-}

880readWriteFinallyStream :: Handle -> Handle -> IO ()

881readWriteFinallyStream inh devNull =

882 let readEx = S.finally (hClose inh) (S.unfold FH.read inh)

883 in S.fold (FH.write devNull) readEx

884

885{-# INLINE readWriteFinallyIOStream #-}

886readWriteFinallyIOStream :: Handle -> Handle -> IO ()

887readWriteFinallyIOStream inh devNull =

888 let readEx = IP.finallyIO (hClose inh) (S.unfold FH.read inh)

889 in S.fold (FH.write devNull) readEx

890

891-- | Send the file contents to /dev/null with exception handling

892{-# INLINE fromToBytesBracketStream #-}

893fromToBytesBracketStream :: Handle -> Handle -> IO ()

894fromToBytesBracketStream inh devNull =

895 let readEx = S.bracket (return ()) (\_ -> hClose inh)

896 (\_ -> IFH.toBytes inh)

897 in IFH.fromBytes devNull $ readEx

898

899#ifdef INSPECTION

900inspect $ hasNoTypeClasses 'readWriteBracketStream

901-- inspect $ 'readWriteBracketStream `hasNoType` ''Step

902#endif

903

904{-# INLINE fromToBytesBracketIOStream #-}

905fromToBytesBracketIOStream :: Handle -> Handle -> IO ()

906fromToBytesBracketIOStream inh devNull =

907 let readEx = IP.bracketIO (return ()) (\_ -> hClose inh)

908 (\_ -> IFH.toBytes inh)

909 in IFH.fromBytes devNull $ readEx

910

911o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]

912o_1_space_copy_stream_exceptions env =

913 [ bgroup "copy/read/exceptions"

914 [ mkBenchSmall "S.onException" env $ \inh _ ->

915 readWriteOnExceptionStream inh (nullH env)

916 , mkBenchSmall "S.handle" env $ \inh _ ->

917 readWriteHandleExceptionStream inh (nullH env)

918 , mkBenchSmall "S.finally" env $ \inh _ ->

919 readWriteFinallyStream inh (nullH env)

920 , mkBenchSmall "S.finallyIO" env $ \inh _ ->

921 readWriteFinallyIOStream inh (nullH env)

922 ]

923 , bgroup "copy/fromToBytes/exceptions"

924 [ mkBenchSmall "S.bracket" env $ \inh _ ->

925 fromToBytesBracketStream inh (nullH env)

926 , mkBenchSmall "S.bracketIO" env $ \inh _ ->

927 fromToBytesBracketIOStream inh (nullH env)

928 ]

929 ]

930

931-------------------------------------------------------------------------------

932-- copy with group/ungroup transformations

933-------------------------------------------------------------------------------

934

935-- | Lines and unlines

936{-# INLINE copyChunksSplitInterposeSuffix #-}

937copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO ()

938copyChunksSplitInterposeSuffix inh outh =

939 S.fold (IFH.writeWithBufferOf (1024*1024) outh)

940 $ AS.interposeSuffix 10

941 $ AS.splitOnSuffix 10

942 $ IFH.toChunksWithBufferOf (1024*1024) inh

943

944#ifdef INSPECTION

945inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Storable]

946-- inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step

947#endif

948

949-- | Words and unwords

950{-# INLINE copyChunksSplitInterpose #-}

951copyChunksSplitInterpose :: Handle -> Handle -> IO ()

952copyChunksSplitInterpose inh outh =

953 S.fold (IFH.writeWithBufferOf (1024*1024) outh)

954 $ AS.interpose 32

955 -- XXX this is not correct word splitting combinator

956 $ AS.splitOn 32

957 $ IFH.toChunksWithBufferOf (1024*1024) inh

958

959#ifdef INSPECTION

960inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Storable]

961-- inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step

962#endif

963

964o_1_space_copy_toChunks_group_ungroup :: BenchEnv -> [Benchmark]

965o_1_space_copy_toChunks_group_ungroup env =

966 [ bgroup "copy/toChunks/group-ungroup"

967 [ mkBench "AS.interposeSuffix . AS.splitOnSuffix" env $ \inh outh ->

968 copyChunksSplitInterposeSuffix inh outh

969 , mkBenchSmall "AS.interpose . AS.splitOn" env $ \inh outh ->

970 copyChunksSplitInterpose inh outh

971 ]

972 ]

973

974-------------------------------------------------------------------------------

975-- copy with group/ungroup transformations

976-------------------------------------------------------------------------------

977

978{-# INLINE linesUnlinesCopy #-}

979linesUnlinesCopy :: Handle -> Handle -> IO ()

980linesUnlinesCopy inh outh =

981 S.fold (FH.write outh)

982 $ SS.encodeLatin1

983 $ IUS.unlines IUF.fromList

984 $ S.splitOnSuffix (== '\n') FL.toList

985 $ SS.decodeLatin1

986 $ S.unfold FH.read inh

987

988{-# INLINE linesUnlinesArrayWord8Copy #-}

989linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO ()

990linesUnlinesArrayWord8Copy inh outh =

991 S.fold (FH.write outh)

992 $ IP.interposeSuffix 10 A.read

993 $ S.splitOnSuffix (== 10) A.write

994 $ S.unfold FH.read inh

995

996-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion

997-- | Lines and unlines

998{-# INLINE linesUnlinesArrayCharCopy #-}

999linesUnlinesArrayCharCopy :: Handle -> Handle -> IO ()

1000linesUnlinesArrayCharCopy inh outh =

1001 S.fold (FH.write outh)

1002 $ SS.encodeLatin1

1003 $ IUA.unlines

1004 $ IUA.lines

1005 $ SS.decodeLatin1

1006 $ S.unfold FH.read inh

1007

1008#ifdef INSPECTION

1009inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Storable]

1010-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step

1011-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''AT.FlattenState

1012-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''D.ConcatMapUState

1013#endif

1014

1015-- XXX to write this we need to be able to map decodeUtf8 on the A.read fold.

1016-- For that we have to write decodeUtf8 as a Pipe.

1017{-

1018{-# INLINE linesUnlinesArrayUtf8Copy #-}

1019linesUnlinesArrayUtf8Copy :: Handle -> Handle -> IO ()

1020linesUnlinesArrayUtf8Copy inh outh =

1021 S.fold (FH.write outh)

1022 $ SS.encodeLatin1

1023 $ IP.intercalate (A.fromList [10]) (pipe SS.decodeUtf8P A.read)

1024 $ S.splitOnSuffix (== '\n') (IFL.lmap SS.encodeUtf8 A.write)

1025 $ SS.decodeLatin1

1026 $ S.unfold FH.read inh

1027-}

1028

1029foreign import ccall unsafe "u_iswspace"

1030 iswspace :: Int -> Int

1031

1032-- Code copied from base/Data.Char to INLINE it

1033{-# INLINE isSpace #-}

1034isSpace :: Char -> Bool

1035-- isSpace includes non-breaking space

1036-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints

1037-- at or below 0x377 have been assigned, so we shouldn't have to worry about

1038-- any new spaces appearing below there. It would probably be best to

1039-- use branchless ||, but currently the eqLit transformation will undo that,

1040-- so we'll do it like this until there's a way around that.

1041isSpace c

1042 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0

1043 | otherwise = iswspace (ord c) /= 0

1044 where

1045 uc = fromIntegral (ord c) :: Word

1046

1047{-# INLINE isSp #-}

1048isSp :: Word8 -> Bool

1049isSp = isSpace . chr . fromIntegral

1050

1051-- | Word, unwords and copy

1052{-# INLINE wordsUnwordsCopyWord8 #-}

1053wordsUnwordsCopyWord8 :: Handle -> Handle -> IO ()

1054wordsUnwordsCopyWord8 inh outh =

1055 S.fold (FH.write outh)

1056 $ IP.interposeSuffix 32 IUF.fromList

1057 $ S.wordsBy isSp FL.toList

1058 $ S.unfold FH.read inh

1059

1060#ifdef INSPECTION

1061inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8

1062-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''Step

1063-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''D.ConcatMapUState

1064#endif

1065

1066-- | Word, unwords and copy

1067{-# INLINE wordsUnwordsCopy #-}

1068wordsUnwordsCopy :: Handle -> Handle -> IO ()

1069wordsUnwordsCopy inh outh =

1070 S.fold (FH.write outh)

1071 $ SS.encodeLatin1

1072 $ IUS.unwords IUF.fromList

1073 -- XXX This pipeline does not fuse with wordsBy but fuses with splitOn

1074 -- with -funfolding-use-threshold=300. With wordsBy it does not fuse

1075 -- even with high limits for inlining and spec-constr ghc options. With

1076 -- -funfolding-use-threshold=400 it performs pretty well and there

1077 -- is no evidence in the core that a join point involving Step

1078 -- constructors is not getting inlined. Not being able to fuse at all in

1079 -- this case could be an unknown issue, need more investigation.

1080 $ S.wordsBy isSpace FL.toList

1081 -- -- $ S.splitOn isSpace FL.toList

1082 $ SS.decodeLatin1

1083 $ S.unfold FH.read inh

1084

1085#ifdef INSPECTION

1086-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy

1087-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step

1088-- inspect $ 'wordsUnwordsCopy `hasNoType` ''AT.FlattenState

1089-- inspect $ 'wordsUnwordsCopy `hasNoType` ''D.ConcatMapUState

1090#endif

1091

1092{-# INLINE wordsUnwordsCharArrayCopy #-}

1093wordsUnwordsCharArrayCopy :: Handle -> Handle -> IO ()

1094wordsUnwordsCharArrayCopy inh outh =

1095 S.fold (FH.write outh)

1096 $ SS.encodeLatin1

1097 $ IUA.unwords

1098 $ IUA.words

1099 $ SS.decodeLatin1

1100 $ S.unfold FH.read inh

1101

1102o_1_space_copy_read_group_ungroup :: BenchEnv -> [Benchmark]

1103o_1_space_copy_read_group_ungroup env =

1104 [ bgroup "copy/read/group-ungroup"

1105 [ mkBenchSmall "US.unlines . S.splitOnSuffix ([Word8])" env

1106 $ \inh outh -> linesUnlinesCopy inh outh

1107 , mkBenchSmall "S.interposeSuffix . S.splitOnSuffix(Array Word8)" env

1108 $ \inh outh -> linesUnlinesArrayWord8Copy inh outh

1109 , mkBenchSmall "UA.unlines . UA.lines (Array Char)" env

1110 $ \inh outh -> linesUnlinesArrayCharCopy inh outh

1111

1112 , mkBenchSmall "S.interposeSuffix . S.wordsBy ([Word8])" env

1113 $ \inh outh -> wordsUnwordsCopyWord8 inh outh

1114 , mkBenchSmall "US.unwords . S.wordsBy ([Char])" env

1115 $ \inh outh -> wordsUnwordsCopy inh outh

1116 , mkBenchSmall "UA.unwords . UA.words (Array Char)" env

1117 $ \inh outh -> wordsUnwordsCharArrayCopy inh outh

1118 ]

1119 ]

1120

1121-------------------------------------------------------------------------------

1122-- reduce with splitting transformations

1123-------------------------------------------------------------------------------

1124

1125lf :: Word8

1126lf = fromIntegral (ord '\n')

1127

1128toarr :: String -> A.Array Word8

1129toarr = A.fromList . map (fromIntegral . ord)

1130

1131-- | Split on line feed.

1132{-# INLINE splitOn #-}

1133splitOn :: Handle -> IO Int

1134splitOn inh =

1135 (S.length $ S.splitOn (== lf) FL.drain

1136 $ S.unfold FH.read inh) -- >>= print

1137

1138#ifdef INSPECTION

1139inspect $ hasNoTypeClasses 'splitOn

1140inspect $ 'splitOn `hasNoType` ''Step

1141inspect $ 'splitOn `hasNoType` ''AT.FlattenState

1142inspect $ 'splitOn `hasNoType` ''D.ConcatMapUState

1143#endif

1144

1145-- | Split suffix on line feed.

1146{-# INLINE splitOnSuffix #-}

1147splitOnSuffix :: Handle -> IO Int

1148splitOnSuffix inh =

1149 (S.length $ S.splitOnSuffix (== lf) FL.drain

1150 $ S.unfold FH.read inh) -- >>= print

1151

1152#ifdef INSPECTION

1153inspect $ hasNoTypeClasses 'splitOnSuffix

1154inspect $ 'splitOnSuffix `hasNoType` ''Step

1155inspect $ 'splitOnSuffix `hasNoType` ''AT.FlattenState

1156inspect $ 'splitOnSuffix `hasNoType` ''D.ConcatMapUState

1157#endif

1158

1159-- | Split on line feed.

1160{-# INLINE parseManySepBy #-}

1161parseManySepBy :: Handle -> IO Int

1162parseManySepBy inh =

1163 (S.length $ IP.parseMany (PR.sliceSepBy (== lf) FL.drain)

1164 (S.unfold FH.read inh)) -- >>= print

1165

1166-- | Words by space

1167{-# INLINE wordsBy #-}

1168wordsBy :: Handle -> IO Int

1169wordsBy inh =

1170 (S.length $ S.wordsBy isSp FL.drain

1171 $ S.unfold FH.read inh) -- >>= print

1172

1173#ifdef INSPECTION

1174inspect $ hasNoTypeClasses 'wordsBy

1175inspect $ 'wordsBy `hasNoType` ''Step

1176inspect $ 'wordsBy `hasNoType` ''AT.FlattenState

1177inspect $ 'wordsBy `hasNoType` ''D.ConcatMapUState

1178#endif

1179

1180-- | Split on a word8 sequence.

1181{-# INLINE splitOnSeq #-}

1182splitOnSeq :: String -> Handle -> IO Int

1183splitOnSeq str inh =

1184 (S.length $ IP.splitOnSeq (toarr str) FL.drain

1185 $ S.unfold FH.read inh) -- >>= print

1186

1187#ifdef INSPECTION

1188-- inspect $ hasNoTypeClasses 'splitOnSeq

1189-- inspect $ 'splitOnSeq `hasNoType` ''Step

1190-- inspect $ 'splitOnSeq `hasNoType` ''AT.FlattenState

1191-- inspect $ 'splitOnSeq `hasNoType` ''D.ConcatMapUState

1192#endif

1193

1194-- | Split on suffix sequence.

1195{-# INLINE splitOnSuffixSeq #-}

1196splitOnSuffixSeq :: String -> Handle -> IO Int

1197splitOnSuffixSeq str inh =

1198 (S.length $ IP.splitOnSuffixSeq (toarr str) FL.drain

1199 $ S.unfold FH.read inh) -- >>= print

1200

1201#ifdef INSPECTION

1202-- inspect $ hasNoTypeClasses 'splitOnSuffixSeq

1203-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step

1204-- inspect $ 'splitOnSuffixSeq `hasNoType` ''AT.FlattenState

1205-- inspect $ 'splitOnSuffixSeq `hasNoType` ''D.ConcatMapUState

1206#endif

1207

1208o_1_space_reduce_read_split :: BenchEnv -> [Benchmark]

1209o_1_space_reduce_read_split env =

1210 [ bgroup "reduce/read"

1211 [ mkBench "S.parseMany (PR.sliceSepBy (== lf) FL.drain)" env

1212 $ \inh _ -> parseManySepBy inh

1213 , mkBench "S.wordsBy isSpace FL.drain" env $ \inh _ ->

1214 wordsBy inh

1215 , mkBench "S.splitOn (== lf) FL.drain" env $ \inh _ ->

1216 splitOn inh

1217 , mkBench "S.splitOnSuffix (== lf) FL.drain" env $ \inh _ ->

1218 splitOnSuffix inh

1219 , mkBench "S.splitOnSeq \"\" FL.drain" env $ \inh _ ->

1220 splitOnSeq "" inh

1221 , mkBench "S.splitOnSuffixSeq \"\" FL.drain" env $ \inh _ ->

1222 splitOnSuffixSeq "" inh

1223 , mkBench "S.splitOnSeq \"\\n\" FL.drain" env $ \inh _ ->

1224 splitOnSeq "\n" inh

1225 , mkBench "S.splitOnSuffixSeq \"\\n\" FL.drain" env $ \inh _ ->

1226 splitOnSuffixSeq "\n" inh

1227 , mkBench "S.splitOnSeq \"a\" FL.drain" env $ \inh _ ->

1228 splitOnSeq "a" inh

1229 , mkBench "S.splitOnSeq \"\\r\\n\" FL.drain" env $ \inh _ ->

1230 splitOnSeq "\r\n" inh

1231 , mkBench "S.splitOnSuffixSeq \"\\r\\n\" FL.drain" env $ \inh _ ->

1232 splitOnSuffixSeq "\r\n" inh

1233 , mkBench "S.splitOnSeq \"aa\" FL.drain" env $ \inh _ ->

1234 splitOnSeq "aa" inh

1235 , mkBench "S.splitOnSeq \"aaaa\" FL.drain" env $ \inh _ ->

1236 splitOnSeq "aaaa" inh

1237 , mkBench "S.splitOnSeq \"abcdefgh\" FL.drain" env $ \inh _ ->

1238 splitOnSeq "abcdefgh" inh

1239 , mkBench "S.splitOnSeq \"abcdefghi\" FL.drain" env $ \inh _ ->

1240 splitOnSeq "abcdefghi" inh

1241 , mkBench "S.splitOnSeq \"catcatcatcatcat\" FL.drain" env $ \inh _ ->

1242 splitOnSeq "catcatcatcatcat" inh

1243 , mkBench "S.splitOnSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"

1244 env $ \inh _ -> splitOnSeq "abcdefghijklmnopqrstuvwxyz" inh

1245 , mkBenchSmall "S.splitOnSuffixSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"

1246 env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh

1247 ]

1248 ]

1249

1250-- | Split on a character sequence.

1251{-# INLINE splitOnSeqUtf8 #-}

1252splitOnSeqUtf8 :: String -> Handle -> IO Int

1253splitOnSeqUtf8 str inh =

1254 (S.length $ IP.splitOnSeq (A.fromList str) FL.drain

1255 $ IUS.decodeUtf8ArraysLenient

1256 $ IFH.toChunks inh) -- >>= print

1257

1258o_1_space_reduce_toChunks_split :: BenchEnv -> [Benchmark]

1259o_1_space_reduce_toChunks_split env =

1260 [ bgroup "reduce/toChunks"

1261 [ mkBenchSmall ("S.splitOnSeqUtf8 \"abcdefgh\" FL.drain "

1262 ++ ". US.decodeUtf8ArraysLenient") env $ \inh _ ->

1263 splitOnSeqUtf8 "abcdefgh" inh

1264 , mkBenchSmall "S.splitOnSeqUtf8 \"abcdefghijklmnopqrstuvwxyz\" FL.drain"

1265 env $ \inh _ -> splitOnSeqUtf8 "abcdefghijklmnopqrstuvwxyz" inh

1266 ]

1267 ]

1268

1269-------------------------------------------------------------------------------

1270--

1271-------------------------------------------------------------------------------

1272

1273main :: IO ()

1274main = do

1275 (_, cfg, benches) <- parseCLIOpts defaultStreamSize

1276 r <- lookupEnv "Benchmark.FileSystem.Handle.InputFile"

1277 (small, big) <-

1278 case r of

1279 Just inFileName -> return (inFileName, inFileName)

1280 Nothing -> do

1281 -- XXX will this work on windows/msys?

1282 let cmd infile size =

1283 "mkdir -p " ++ scratchDir

1284 ++ "; test -e " ++ infile

1285 ++ " || { echo \"creating input file " ++ infile

1286 ++ "\" && dd if=/dev/random of=" ++ infile

1287 ++ " bs=" ++ show blockSize

1288 ++ " count=" ++ show (blockCount size)

1289 ++ ";}"

1290 runProcess_ (shell (cmd inFileSmall smallFileSize))

1291 runProcess_ (shell (cmd inFileBig bigFileSize))

1292 return (inFileSmall, inFileBig)

1293

1294 smallHandle <- openFile small ReadMode

1295 bigHandle <- openFile big ReadMode

1296 outHandle <- openFile outfile WriteMode

1297 devNull <- openFile "/dev/null" WriteMode

1298

1299#if __GLASGOW_HASKELL__ >= 800

1300 ssize <- fromIntegral <$> getFileSize small

1301 bsize <- fromIntegral <$> getFileSize big

1302#else

1303 let ssize = smallFileSize

1304 let bsize = bigFileSize

1305#endif

1306

1307 ref <- newIORef $ RefHandles

1308 { smallInH = smallHandle

1309 , bigInH = bigHandle

1310 , outputH = outHandle

1311 }

1312

1313 let env = BenchEnv

1314 { href = ref

1315 , smallSize = ssize

1316 , bigSize = bsize

1317 , nullH = devNull

1318 }

1319

1320 runMode (mode cfg) cfg benches (allBenchmarks env)

1321

1322 where

1323

1324 allBenchmarks env =

1325 [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat

1326 [ o_1_space_read_chunked env

1327 , o_1_space_copy_chunked env

1328 , o_1_space_copy_exceptions_readChunks env

1329 , o_1_space_copy_exceptions_toChunks env

1330

1331 , o_1_space_reduce_read env

1332 , o_1_space_reduce_toBytes env

1333 , o_1_space_reduce_read_grouped env

1334 , o_1_space_reduce_read_split env

1335 , o_1_space_reduce_toChunks_split env

1336

1337 , o_1_space_copy_read env

1338 , o_1_space_copy_fromBytes env

1339 , o_1_space_copy_read_exceptions env

1340 , o_1_space_copy_stream_exceptions env

1341 , o_1_space_copy_toChunks_group_ungroup env

1342 , o_1_space_copy_read_group_ungroup env

1343 ]

1344 ]