f7f8b0a · streamly · git.iko.soy

git.iko.soy/streamly

Move group/ungroup benchmarks from FileSystem.Handle to Unicode.Stream, Add Unicode.Stream to bench.sh, Add Unicode and CommonH files to streamly.cabal

f7f8b0aAnurag Hooda6 years ago

bench.sh+1

compare with master

unifiedsplit

@@ -80,6 +80,7 @@ all_grp="\

80 $prelude_concurrent_grp \

81 $array_grp \

82 $parser_grp \

83+ Unicode.Stream \

83 Data.Unfold \

84 Data.Unfold \

84 FileSystem.Handle"

85 FileSystem.Handle"

benchmark/Streamly/Benchmark/FileSystem/Handle.hs−63

@@ -20,22 +20,14 @@

20#endif

22#if __GLASGOW_HASKELL__ >= 800

23−import System.Directory (getFileSize)

24#endif

23#endif

25−import System.Environment (lookupEnv)

26−import System.IO (openFile, IOMode(..))

27−import System.Process.Typed (shell, runProcess_)

28import Prelude hiding (last, length)

24import Prelude hiding (last, length)

30import qualified Handle.ReadWrite as RW

26import qualified Handle.ReadWrite as RW

31import qualified Handle.Read as RO

27import qualified Handle.Read as RO

33−import Data.IORef

34import Gauge hiding (env)

29import Gauge hiding (env)

35import Streamly.Benchmark.Common

30import Streamly.Benchmark.Common

36−-- TBD Change it to point to Common in parent directory

37−-- Done

38−-- import Handle.Common

39import Streamly.Benchmark.CommonH

31import Streamly.Benchmark.CommonH

41-------------------------------------------------------------------------------

33-------------------------------------------------------------------------------

@@ -49,65 +41,10 @@ moduleName = "FileSystem.Handle"

49--

41--

50-------------------------------------------------------------------------------

42-------------------------------------------------------------------------------

52−-- smallFileSize :: Int

53−-- smallFileSize = 10 * 1024 * 1024

54−

55−-- bigFileSize :: Int

56−-- bigFileSize = 100 * 1024 * 1024

57−

58−-------------------------------------------------------------------------------

59−--

60−-------------------------------------------------------------------------------

61−

62main :: IO ()

44main :: IO ()

63main = do

45main = do

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

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

65 env <- mkBenchEnv "Benchmark_FileSystem_Handle_InputFile"

47 env <- mkBenchEnv "Benchmark_FileSystem_Handle_InputFile"

66− -- r <- lookupEnv "Benchmark_FileSystem_Handle_InputFile"

67− -- (small, big) <-

68− -- case r of

69− -- Just inFileName -> return (inFileName, inFileName)

70− -- Nothing -> do

71− -- -- XXX will this work on windows/msys?

72− -- let cmd infile size =

73− -- "mkdir -p " ++ scratchDir

74− -- ++ "; test -e " ++ infile

75− -- ++ " || { echo \"creating input file " ++ infile

76− -- ++ "\" && head -c " ++ show size

77− -- ++ " </dev/urandom >" ++ infile

78− -- ++ ";}"

79− -- runProcess_ (shell (cmd inFileSmall smallFileSize))

80− -- runProcess_ (shell (cmd inFileBig bigFileSize))

81− -- return (inFileSmall, inFileBig)

82−

83− -- putStrLn $ "Using small input file: " ++ small

84− -- smallHandle <- openFile small ReadMode

85−

86− -- putStrLn $ "Using big input file: " ++ big

87− -- bigHandle <- openFile big ReadMode

88−

89− -- putStrLn $ "Using output file: " ++ outfile

90− -- outHandle <- openFile outfile WriteMode

91− -- devNull <- openFile "/dev/null" WriteMode

92−

93− -- ssize <- fromIntegral <$> getFileSize small

94− -- bsize <- fromIntegral <$> getFileSize big

95−

96− -- ref <- newIORef $ RefHandles

97− -- { smallInH = smallHandle

98− -- , bigInH = bigHandle

99− -- , outputH = outHandle

100− -- }

101−

102− -- let env = BenchEnv

103− -- { href = ref

104− -- , smallSize = ssize

105− -- , bigSize = bsize

106− -- , nullH = devNull

107− -- , smallInFile = small

108− -- , bigInFile = big

109− -- }

110−

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

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

112

113 where

50 where

benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs−3

@@ -23,7 +23,6 @@ module Handle.Read

23 (allBenchmarks)

24where

26−import Data.Char (ord)

27import Data.Functor.Identity (runIdentity)

26import Data.Functor.Identity (runIdentity)

28import Data.Word (Word8)

27import Data.Word (Word8)

29import GHC.Magic (inline)

28import GHC.Magic (inline)

@@ -389,6 +388,4 @@ allBenchmarks env = Prelude.concat

389 , o_1_space_reduce_read env

388 , o_1_space_reduce_read env

390 , o_1_space_reduce_toBytes env

389 , o_1_space_reduce_toBytes env

391 , o_1_space_reduce_read_grouped env

390 , o_1_space_reduce_read_grouped env

392− -- , o_1_space_reduce_read_split env

393− -- , o_1_space_reduce_toChunks_split env

394 ]

391 ]

benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs+1−212

@@ -23,20 +23,14 @@ module Handle.ReadWrite

23 (allBenchmarks)

24where

26−import Control.Exception (SomeException)

27−import System.IO (Handle, hClose, hPutChar)

26+import System.IO (Handle)

28import Prelude hiding (last, length)

27import Prelude hiding (last, length)

29import Streamly.Internal.Data.Array.Storable.Foreign.Types (defaultChunkSize)

28import Streamly.Internal.Data.Array.Storable.Foreign.Types (defaultChunkSize)

31−import qualified Streamly.Data.Fold as FL

32−import qualified Streamly.Unicode.Stream as SS

33import qualified Streamly.FileSystem.Handle as FH

30import qualified Streamly.FileSystem.Handle as FH

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

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

35−import qualified Streamly.Internal.Unicode.Stream as IUS

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

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

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

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

38−import qualified Streamly.Internal.Unicode.Array.Char as IUA

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

40import qualified Streamly.Data.Array.Storable.Foreign as A

34import qualified Streamly.Data.Array.Storable.Foreign as A

41import qualified Streamly.Prelude as S

35import qualified Streamly.Prelude as S

@@ -69,19 +63,6 @@ inspect $ hasNoTypeClasses 'copyChunks

69inspect $ 'copyChunks `hasNoType` ''Step

63inspect $ 'copyChunks `hasNoType` ''Step

70#endif

64#endif

72−-- | Copy file

73−copyCodecUtf8ArraysLenient :: Handle -> Handle -> IO ()

74−copyCodecUtf8ArraysLenient inh outh =

75− S.fold (FH.write outh)

76− $ SS.encodeUtf8'

77− $ IUS.decodeUtf8Arrays

78− $ IFH.toChunks inh

79−

80−#ifdef INSPECTION

81−inspect $ hasNoTypeClasses 'copyCodecUtf8ArraysLenient

82−-- inspect $ 'copyCodecUtf8ArraysLenient `hasNoType` ''Step

83−#endif

84−

85o_1_space_copy_chunked :: BenchEnv -> [Benchmark]

66o_1_space_copy_chunked :: BenchEnv -> [Benchmark]

86o_1_space_copy_chunked env =

67o_1_space_copy_chunked env =

87 [ bgroup "copy/toChunks"

68 [ bgroup "copy/toChunks"

@@ -89,8 +70,6 @@ o_1_space_copy_chunked env =

89 copyChunks inH (nullH env)

70 copyChunks inH (nullH env)

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

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

91 copyChunks inH outH

72 copyChunks inH outH

92− , mkBenchSmall "decodeEncodeUtf8Lenient" env $ \inH outH ->

93− copyCodecUtf8ArraysLenient inH outH

94 ]

73 ]

95 ]

74 ]

@@ -111,70 +90,6 @@ inspect $ 'copyStream `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe

111inspect $ 'copyStream `hasNoType` ''Strict.Tuple3' -- FH.write/lchunksOf

90inspect $ 'copyStream `hasNoType` ''Strict.Tuple3' -- FH.write/lchunksOf

112#endif

91#endif

113

114−-- | Copy file (encodeLatin1')

115−copyStreamLatin1' :: Handle -> Handle -> IO ()

116−copyStreamLatin1' inh outh =

117− S.fold (FH.write outh)

118− $ SS.encodeLatin1'

119− $ SS.decodeLatin1

120− $ S.unfold FH.read inh

121−

122−#ifdef INSPECTION

123−inspect $ hasNoTypeClasses 'copyStreamLatin1'

124−inspect $ 'copyStreamLatin1' `hasNoType` ''Step

125−inspect $ 'copyStreamLatin1' `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat

126−inspect $ 'copyStreamLatin1' `hasNoType` ''A.ReadUState -- FH.read/A.read

127−inspect $ 'copyStreamLatin1' `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe

128−inspect $ 'copyStreamLatin1' `hasNoType` ''Strict.Tuple3' -- FH.write/lchunksOf

129−#endif

130−

131−-- | Copy file (encodeLatin1)

132−copyStreamLatin1 :: Handle -> Handle -> IO ()

133−copyStreamLatin1 inh outh =

134− S.fold (FH.write outh)

135− $ SS.encodeLatin1

136− $ SS.decodeLatin1

137− $ S.unfold FH.read inh

138−

139−#ifdef INSPECTION

140−inspect $ hasNoTypeClasses 'copyStreamLatin1

141−inspect $ 'copyStreamLatin1 `hasNoType` ''Step

142−inspect $ 'copyStreamLatin1 `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat

143−inspect $ 'copyStreamLatin1 `hasNoType` ''A.ReadUState -- FH.read/A.read

144−inspect $ 'copyStreamLatin1 `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe

145−inspect $ 'copyStreamLatin1 `hasNoType` ''Strict.Tuple3' -- FH.write/lchunksOf

146−#endif

147−

148−-- | Copy file

149−_copyStreamUtf8' :: Handle -> Handle -> IO ()

150−_copyStreamUtf8' inh outh =

151− S.fold (FH.write outh)

152− $ SS.encodeUtf8'

153− $ SS.decodeUtf8'

154− $ S.unfold FH.read inh

155−

156−#ifdef INSPECTION

157−inspect $ hasNoTypeClasses '_copyStreamUtf8'

158−-- inspect $ '_copyStreamUtf8 `hasNoType` ''Step

159−-- inspect $ '_copyStreamUtf8 `hasNoType` ''AT.FlattenState

160−-- inspect $ '_copyStreamUtf8 `hasNoType` ''D.ConcatMapUState

161−#endif

162−

163−-- | Copy file

164−copyStreamUtf8 :: Handle -> Handle -> IO ()

165−copyStreamUtf8 inh outh =

166− S.fold (FH.write outh)

167− $ SS.encodeUtf8

168− $ SS.decodeUtf8

169− $ S.unfold FH.read inh

170−

171−#ifdef INSPECTION

172−inspect $ hasNoTypeClasses 'copyStreamUtf8

173−-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''Step

174−-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''AT.FlattenState

175−-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''D.ConcatMapUState

176−#endif

177−

178o_1_space_copy_read :: BenchEnv -> [Benchmark]

93o_1_space_copy_read :: BenchEnv -> [Benchmark]

179o_1_space_copy_read env =

94o_1_space_copy_read env =

180 [ bgroup "copy/read"

95 [ bgroup "copy/read"

@@ -182,17 +97,6 @@ o_1_space_copy_read env =

182 copyStream inh (nullH env)

97 copyStream inh (nullH env)

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

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

184 copyStream inh outh

99 copyStream inh outh

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

186− , mkBench "SS.encodeLatin1' . SS.decodeLatin1" env $ \inh outh ->

187− copyStreamLatin1' inh outh

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

189− copyStreamLatin1 inh outh

190−#ifdef DEVBUILD

191− , mkBench "copyUtf8" env $ \inh outh ->

192− _copyStreamUtf8' inh outh

193−#endif

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

195− copyStreamUtf8 inh outh

196 ]

100 ]

197 ]

101 ]

198

102

@@ -344,120 +248,6 @@ o_1_space_copy_toChunks_group_ungroup env =

344 ]

248 ]

345 ]

249 ]

346

250

347−-------------------------------------------------------------------------------

348−-- copy with group/ungroup transformations

349−-------------------------------------------------------------------------------

350−

351−linesUnlinesCopy :: Handle -> Handle -> IO ()

352−linesUnlinesCopy inh outh =

353− S.fold (FH.write outh)

354− $ SS.encodeLatin1'

355− $ IUS.unlines IUF.fromList

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

357− $ SS.decodeLatin1

358− $ S.unfold FH.read inh

359−

360−linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO ()

361−linesUnlinesArrayWord8Copy inh outh =

362− S.fold (FH.write outh)

363− $ IP.interposeSuffix 10 A.read

364− $ S.splitOnSuffix (== 10) A.write

365− $ S.unfold FH.read inh

366−

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

368−-- | Lines and unlines

369−linesUnlinesArrayCharCopy :: Handle -> Handle -> IO ()

370−linesUnlinesArrayCharCopy inh outh =

371− S.fold (FH.write outh)

372− $ SS.encodeLatin1'

373− $ IUA.unlines

374− $ IUA.lines

375− $ SS.decodeLatin1

376− $ S.unfold FH.read inh

377−

378−#ifdef INSPECTION

379−inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Storable]

380−-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step

381−#endif

382−

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

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

385−{-

386−{-# INLINE linesUnlinesArrayUtf8Copy #-}

387−linesUnlinesArrayUtf8Copy :: Handle -> Handle -> IO ()

388−linesUnlinesArrayUtf8Copy inh outh =

389− S.fold (FH.write outh)

390− $ SS.encodeLatin1'

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

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

393− $ SS.decodeLatin1

394− $ S.unfold FH.read inh

395−-}

396−

397−-- | Word, unwords and copy

398−wordsUnwordsCopyWord8 :: Handle -> Handle -> IO ()

399−wordsUnwordsCopyWord8 inh outh =

400− S.fold (FH.write outh)

401− $ IP.interposeSuffix 32 IUF.fromList

402− $ S.wordsBy isSp FL.toList

403− $ S.unfold FH.read inh

404−

405−#ifdef INSPECTION

406−inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8

407−-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''Step

408−#endif

409−

410−-- | Word, unwords and copy

411−wordsUnwordsCopy :: Handle -> Handle -> IO ()

412−wordsUnwordsCopy inh outh =

413− S.fold (FH.write outh)

414− $ SS.encodeLatin1'

415− $ IUS.unwords IUF.fromList

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

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

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

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

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

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

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

423− $ S.wordsBy isSpace FL.toList

424− -- -- $ S.splitOn isSpace FL.toList

425− $ SS.decodeLatin1

426− $ S.unfold FH.read inh

427−

428−#ifdef INSPECTION

429−-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy

430−-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step

431−#endif

432−

433−{-# NOINLINE wordsUnwordsCharArrayCopy #-}

434−wordsUnwordsCharArrayCopy :: Handle -> Handle -> IO ()

435−wordsUnwordsCharArrayCopy inh outh =

436− S.fold (FH.write outh)

437− $ SS.encodeLatin1'

438− $ IUA.unwords

439− $ IUA.words

440− $ SS.decodeLatin1

441− $ S.unfold FH.read inh

442−

443−o_1_space_copy_read_group_ungroup :: BenchEnv -> [Benchmark]

444−o_1_space_copy_read_group_ungroup env =

445− [ bgroup "copy/read/group-ungroup"

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

447− $ \inh outh -> linesUnlinesCopy inh outh

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

449− $ \inh outh -> linesUnlinesArrayWord8Copy inh outh

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

451− $ \inh outh -> linesUnlinesArrayCharCopy inh outh

452−

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

454− $ \inh outh -> wordsUnwordsCopyWord8 inh outh

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

456− $ \inh outh -> wordsUnwordsCopy inh outh

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

458− $ \inh outh -> wordsUnwordsCharArrayCopy inh outh

459− ]

460− ]

461

251

462-------------------------------------------------------------------------------

252-------------------------------------------------------------------------------

463--

253--

@@ -470,5 +260,4 @@ allBenchmarks env = Prelude.concat

470 , o_1_space_copy_fromBytes env

260 , o_1_space_copy_fromBytes env

471 , o_1_space_copy env

261 , o_1_space_copy env

472 , o_1_space_copy_toChunks_group_ungroup env

262 , o_1_space_copy_toChunks_group_ungroup env

473− , o_1_space_copy_read_group_ungroup env

474 ]

263 ]

benchmark/Streamly/Benchmark/Prelude/Serial/Split.hsnew file+229

@@ -0,0 +1,229 @@

1+ -- |

2+-- Module : Streamly.Benchmark.Prelude.System.Split

4+--

5+-- License : BSD3

6+-- Maintainer : streamly@composewell.com

7+-- Stability : experimental

8+-- Portability : GHC

10+{-# LANGUAGE CPP #-}

11+{-# LANGUAGE ScopedTypeVariables #-}

12+

13+#ifdef __HADDOCK_VERSION__

14+#undef INSPECTION

15+#endif

16+

17+#ifdef INSPECTION

18+{-# LANGUAGE TemplateHaskell #-}

19+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}

20+#endif

21+

22+module Serial.Split

23+ (allBenchmarks)

24+where

25+

26+import Data.Char (ord)

27+import Data.Functor.Identity (runIdentity)

28+import Data.Word (Word8)

29+import GHC.Magic (inline)

30+#if __GLASGOW_HASKELL__ >= 802

31+import GHC.Magic (noinline)

32+#else

33+#define noinline

34+#endif

35+import System.IO (Handle)

36+import Prelude hiding (last, length)

37+

38+import qualified Streamly.Data.Fold as FL

39+import qualified Streamly.Unicode.Stream as SS

40+import qualified Streamly.FileSystem.Handle as FH

41+-- import qualified Streamly.Internal.Data.Fold as IFL

42+import qualified Streamly.Internal.Data.Parser as PR

43+import qualified Streamly.Internal.Data.Stream.StreamD as D

44+import qualified Streamly.Internal.Unicode.Stream as IUS

45+import qualified Streamly.Internal.FileSystem.Handle as IFH

46+import qualified Streamly.Internal.Data.Array.Storable.Foreign as A

47+import qualified Streamly.Internal.Data.Array.Storable.Foreign.Types as AT

48+import qualified Streamly.Internal.Memory.ArrayStream as AS

49+import qualified Streamly.Internal.Data.Stream.IsStream as IP

50+import qualified Streamly.Prelude as S

51+

52+import Gauge hiding (env)

53+-- import Handle.Common

54+import Streamly.Benchmark.CommonH

55+

56+#ifdef INSPECTION

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

58+

59+import qualified Streamly.Internal.Data.Unfold as IUF

60+

61+import Test.Inspection

62+#endif

63+

64+ -------------------------------------------------------------------------------

65+-- reduce with splitting transformations

66+-------------------------------------------------------------------------------

67+

68+lf :: Word8

69+lf = fromIntegral (ord '\n')

70+

71+toarr :: String -> A.Array Word8

72+toarr = A.fromList . map (fromIntegral . ord)

73+

74+-- | Split on line feed.

75+splitOn :: Handle -> IO Int

76+splitOn inh =

77+ (S.length $ S.splitOn (== lf) FL.drain

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

79+

80+#ifdef INSPECTION

81+inspect $ hasNoTypeClasses 'splitOn

82+inspect $ 'splitOn `hasNoType` ''Step

83+inspect $ 'splitOn `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat

84+inspect $ 'splitOn `hasNoType` ''A.ReadUState -- FH.read/A.read

85+#endif

86+

87+-- | Split suffix on line feed.

88+splitOnSuffix :: Handle -> IO Int

89+splitOnSuffix inh =

90+ (S.length $ S.splitOnSuffix (== lf) FL.drain

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

92+

93+#ifdef INSPECTION

94+inspect $ hasNoTypeClasses 'splitOnSuffix

95+inspect $ 'splitOnSuffix `hasNoType` ''Step

96+inspect $ 'splitOnSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat

97+inspect $ 'splitOnSuffix `hasNoType` ''A.ReadUState -- FH.read/A.read

98+#endif

99+

100+-- | Split suffix with line feed.

101+splitWithSuffix :: Handle -> IO Int

102+splitWithSuffix inh =

103+ (S.length $ S.splitWithSuffix (== lf) FL.drain

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

105+

106+#ifdef INSPECTION

107+inspect $ hasNoTypeClasses 'splitWithSuffix

108+inspect $ 'splitWithSuffix `hasNoType` ''Step

109+inspect $ 'splitWithSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat

110+inspect $ 'splitWithSuffix `hasNoType` ''A.ReadUState -- FH.read/A.read

111+#endif

112+

113+-- | Split on line feed.

114+parseManySepBy :: Handle -> IO Int

115+parseManySepBy inh =

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

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

118+

119+-- | Words by space

120+wordsBy :: Handle -> IO Int

121+wordsBy inh =

122+ (S.length $ S.wordsBy isSp FL.drain

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

124+

125+#ifdef INSPECTION

126+inspect $ hasNoTypeClasses 'wordsBy

127+inspect $ 'wordsBy `hasNoType` ''Step

128+inspect $ 'wordsBy `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat

129+inspect $ 'wordsBy `hasNoType` ''A.ReadUState -- FH.read/A.read

130+#endif

131+

132+-- | Split on a word8 sequence.

133+splitOnSeq :: String -> Handle -> IO Int

134+splitOnSeq str inh =

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

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

137+

138+#ifdef INSPECTION

139+-- inspect $ hasNoTypeClasses 'splitOnSeq

140+-- inspect $ 'splitOnSeq `hasNoType` ''Step

141+#endif

142+

143+-- | Split on a word8 sequence.

144+splitOnSeq100k :: Handle -> IO Int

145+splitOnSeq100k inh = do

146+ arr <- A.fromStream $ S.replicate 100000 123

147+ (S.length $ IP.splitOnSeq arr FL.drain

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

149+

150+-- | Split on suffix sequence.

151+splitOnSuffixSeq :: String -> Handle -> IO Int

152+splitOnSuffixSeq str inh =

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

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

155+

156+#ifdef INSPECTION

157+-- inspect $ hasNoTypeClasses 'splitOnSuffixSeq

158+-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step

159+#endif

160+

161+o_1_space_reduce_read_split :: BenchEnv -> [Benchmark]

162+o_1_space_reduce_read_split env =

163+ [ bgroup "reduce/read"

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

165+ $ \inh _ -> parseManySepBy inh

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

167+ wordsBy inh

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

169+ splitOn inh

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

171+ splitOnSuffix inh

172+ , mkBench "S.splitWithSuffix (== lf) FL.drain" env $ \inh _ ->

173+ splitWithSuffix inh

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

175+ splitOnSeq "" inh

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

177+ splitOnSuffixSeq "" inh

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

179+ splitOnSeq "\n" inh

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

181+ splitOnSuffixSeq "\n" inh

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

183+ splitOnSeq "a" inh

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

185+ splitOnSeq "\r\n" inh

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

187+ splitOnSuffixSeq "\r\n" inh

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

189+ splitOnSeq "aa" inh

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

191+ splitOnSeq "aaaa" inh

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

193+ splitOnSeq "abcdefgh" inh

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

195+ splitOnSeq "abcdefghi" inh

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

197+ splitOnSeq "catcatcatcatcat" inh

198+ , mkBench "S.splitOnSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"

199+ env $ \inh _ -> splitOnSeq "abcdefghijklmnopqrstuvwxyz" inh

200+ , mkBench "S.splitOnSeq 100k long pattern"

201+ env $ \inh _ -> splitOnSeq100k inh

202+ , mkBenchSmall "S.splitOnSuffixSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"

203+ env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh

204+ ]

205+ ]

206+

207+-- | Split on a character sequence.

208+splitOnSeqUtf8 :: String -> Handle -> IO Int

209+splitOnSeqUtf8 str inh =

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

211+ $ IUS.decodeUtf8Arrays

212+ $ IFH.toChunks inh) -- >>= print

213+

214+o_1_space_reduce_toChunks_split :: BenchEnv -> [Benchmark]

215+o_1_space_reduce_toChunks_split env =

216+ [ bgroup "reduce/toChunks"

217+ [ mkBenchSmall ("S.splitOnSeqUtf8 \"abcdefgh\" FL.drain "

218+ ++ ". US.decodeUtf8Arrays") env $ \inh _ ->

219+ splitOnSeqUtf8 "abcdefgh" inh

220+ , mkBenchSmall "S.splitOnSeqUtf8 \"abcdefghijklmnopqrstuvwxyz\" FL.drain"

221+ env $ \inh _ -> splitOnSeqUtf8 "abcdefghijklmnopqrstuvwxyz" inh

222+ ]

223+ ]

224+allBenchmarks :: BenchEnv -> [Benchmark]

225+allBenchmarks env = Prelude.concat

226+ [ o_1_space_reduce_read_split env

227+ , o_1_space_reduce_toChunks_split env

228+ ]

229+

benchmark/Streamly/Benchmark/Unicode/Stream.hsnew file+308

@@ -0,0 +1,308 @@

1+-- |

2+-- Module : Streamly.Unicode.Stream

4+--

5+-- License : BSD3

6+-- Maintainer : streamly@composewell.com

7+-- Stability : experimental

8+-- Portability : GHC

10+{-# LANGUAGE CPP #-}

11+{-# LANGUAGE ScopedTypeVariables #-}

12+

13+#ifdef __HADDOCK_VERSION__

14+#undef INSPECTION

15+#endif

16+

17+#ifdef INSPECTION

18+{-# LANGUAGE TemplateHaskell #-}

19+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}

20+#endif

21+

22+import Control.Exception (SomeException)

23+import System.IO (Handle, hClose, hPutChar)

24+import Prelude hiding (last, length)

25+import Streamly.Internal.Data.Array.Storable.Foreign.Types (defaultChunkSize)

26+

27+import qualified Streamly.Data.Fold as FL

28+import qualified Streamly.Unicode.Stream as SS

29+import qualified Streamly.FileSystem.Handle as FH

30+import qualified Streamly.Internal.Data.Unfold as IUF

31+import qualified Streamly.Internal.Unicode.Stream as IUS

32+import qualified Streamly.Internal.FileSystem.Handle as IFH

33+import qualified Streamly.Internal.Unicode.Array.Char as IUA

34+import qualified Streamly.Internal.Data.Stream.IsStream as IP

35+import qualified Streamly.Data.Array.Storable.Foreign as A

36+import qualified Streamly.Prelude as S

37+

38+import Gauge hiding (env)

39+import Streamly.Benchmark.CommonH

40+import Streamly.Benchmark.Common

41+

42+#ifdef INSPECTION

43+import Foreign.Storable (Storable)

44+import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))

45+import qualified Streamly.Internal.Data.Stream.StreamD.Type as D

46+import qualified Streamly.Internal.Data.Tuple.Strict as Strict

47+import qualified Streamly.Internal.Data.Array.Storable.Foreign as A

48+import qualified Streamly.Internal.Data.Array.Storable.Foreign.Types as AT

49+

50+import Test.Inspection

51+#endif

52+

53+moduleName :: String

54+moduleName = "Unicode.Stream"

55+

56+-- | Copy file

57+copyCodecUtf8ArraysLenient :: Handle -> Handle -> IO ()

58+copyCodecUtf8ArraysLenient inh outh =

59+ S.fold (FH.write outh)

60+ $ SS.encodeUtf8'

61+ $ IUS.decodeUtf8Arrays

62+ $ IFH.toChunks inh

63+

64+#ifdef INSPECTION

65+inspect $ hasNoTypeClasses 'copyCodecUtf8ArraysLenient

66+-- inspect $ 'copyCodecUtf8ArraysLenient `hasNoType` ''Step

67+#endif

68+

69+o_1_space_copy_chunked :: BenchEnv -> [Benchmark]

70+o_1_space_copy_chunked env =

71+ [ bgroup "copy/toChunks"

72+ [

73+ mkBenchSmall "decodeEncodeUtf8Lenient" env $ \inH outH ->

74+ copyCodecUtf8ArraysLenient inH outH

75+ ]

76+ ]

77+

78+-------------------------------------------------------------------------------

79+-- copy with group/ungroup transformations

80+-------------------------------------------------------------------------------

81+

82+linesUnlinesCopy :: Handle -> Handle -> IO ()

83+linesUnlinesCopy inh outh =

84+ S.fold (FH.write outh)

85+ $ SS.encodeLatin1'

86+ $ IUS.unlines IUF.fromList

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

88+ $ SS.decodeLatin1

89+ $ S.unfold FH.read inh

90+

91+linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO ()

92+linesUnlinesArrayWord8Copy inh outh =

93+ S.fold (FH.write outh)

94+ $ IP.interposeSuffix 10 A.read

95+ $ S.splitOnSuffix (== 10) A.write

96+ $ S.unfold FH.read inh

97+

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

99+-- | Lines and unlines

100+linesUnlinesArrayCharCopy :: Handle -> Handle -> IO ()

101+linesUnlinesArrayCharCopy inh outh =

102+ S.fold (FH.write outh)

103+ $ SS.encodeLatin1'

104+ $ IUA.unlines

105+ $ IUA.lines

106+ $ SS.decodeLatin1

107+ $ S.unfold FH.read inh

108+

109+#ifdef INSPECTION

110+inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Storable]

111+-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step

112+#endif

113+

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

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

116+{-

117+{-# INLINE linesUnlinesArrayUtf8Copy #-}

118+linesUnlinesArrayUtf8Copy :: Handle -> Handle -> IO ()

119+linesUnlinesArrayUtf8Copy inh outh =

120+ S.fold (FH.write outh)

121+ $ SS.encodeLatin1'

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

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

124+ $ SS.decodeLatin1

125+ $ S.unfold FH.read inh

126+-}

127+

128+-- | Word, unwords and copy

129+wordsUnwordsCopyWord8 :: Handle -> Handle -> IO ()

130+wordsUnwordsCopyWord8 inh outh =

131+ S.fold (FH.write outh)

132+ $ IP.interposeSuffix 32 IUF.fromList

133+ $ S.wordsBy isSp FL.toList

134+ $ S.unfold FH.read inh

135+

136+#ifdef INSPECTION

137+inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8

138+-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''Step

139+#endif

140+

141+-- | Word, unwords and copy

142+wordsUnwordsCopy :: Handle -> Handle -> IO ()

143+wordsUnwordsCopy inh outh =

144+ S.fold (FH.write outh)

145+ $ SS.encodeLatin1'

146+ $ IUS.unwords IUF.fromList

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

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

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

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

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

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

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

154+ $ S.wordsBy isSpace FL.toList

155+ -- -- $ S.splitOn isSpace FL.toList

156+ $ SS.decodeLatin1

157+ $ S.unfold FH.read inh

158+

159+#ifdef INSPECTION

160+-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy

161+-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step

162+#endif

163+

164+wordsUnwordsCharArrayCopy :: Handle -> Handle -> IO ()

165+wordsUnwordsCharArrayCopy inh outh =

166+ S.fold (FH.write outh)

167+ $ SS.encodeLatin1'

168+ $ IUA.unwords

169+ $ IUA.words

170+ $ SS.decodeLatin1

171+ $ S.unfold FH.read inh

172+

173+o_1_space_copy_read_group_ungroup :: BenchEnv -> [Benchmark]

174+o_1_space_copy_read_group_ungroup env =

175+ [ bgroup "copy/read/group-ungroup"

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

177+ $ \inh outh -> linesUnlinesCopy inh outh

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

179+ $ \inh outh -> linesUnlinesArrayWord8Copy inh outh

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

181+ $ \inh outh -> linesUnlinesArrayCharCopy inh outh

182+

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

184+ $ \inh outh -> wordsUnwordsCopyWord8 inh outh

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

186+ $ \inh outh -> wordsUnwordsCopy inh outh

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

188+ $ \inh outh -> wordsUnwordsCharArrayCopy inh outh

189+ ]

190+ ]

191+

192+-------------------------------------------------------------------------------

193+-- copy unfold

194+-------------------------------------------------------------------------------

195+

196+-- -- | Copy file

197+-- copyStream :: Handle -> Handle -> IO ()

198+-- copyStream inh outh = S.fold (FH.write outh) (S.unfold FH.read inh)

199+

200+-- #ifdef INSPECTION

201+-- inspect $ hasNoTypeClasses 'copyStream

202+-- inspect $ 'copyStream `hasNoType` ''Step -- S.unfold

203+-- inspect $ 'copyStream `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat

204+-- inspect $ 'copyStream `hasNoType` ''A.ReadUState -- FH.read/A.read

205+-- inspect $ 'copyStream `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe

206+-- inspect $ 'copyStream `hasNoType` ''Strict.Tuple3' -- FH.write/lchunksOf

207+-- #endif

208+

209+-- | Copy file (encodeLatin1')

210+copyStreamLatin1' :: Handle -> Handle -> IO ()

211+copyStreamLatin1' inh outh =

212+ S.fold (FH.write outh)

213+ $ SS.encodeLatin1'

214+ $ SS.decodeLatin1

215+ $ S.unfold FH.read inh

216+

217+#ifdef INSPECTION

218+inspect $ hasNoTypeClasses 'copyStreamLatin1'

219+inspect $ 'copyStreamLatin1' `hasNoType` ''Step

220+inspect $ 'copyStreamLatin1' `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat

221+inspect $ 'copyStreamLatin1' `hasNoType` ''A.ReadUState -- FH.read/A.read

222+inspect $ 'copyStreamLatin1' `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe

223+inspect $ 'copyStreamLatin1' `hasNoType` ''Strict.Tuple3' -- FH.write/lchunksOf

224+#endif

225+

226+-- | Copy file (encodeLatin1)

227+copyStreamLatin1 :: Handle -> Handle -> IO ()

228+copyStreamLatin1 inh outh =

229+ S.fold (FH.write outh)

230+ $ SS.encodeLatin1

231+ $ SS.decodeLatin1

232+ $ S.unfold FH.read inh

233+

234+#ifdef INSPECTION

235+inspect $ hasNoTypeClasses 'copyStreamLatin1

236+inspect $ 'copyStreamLatin1 `hasNoType` ''Step

237+inspect $ 'copyStreamLatin1 `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat

238+inspect $ 'copyStreamLatin1 `hasNoType` ''A.ReadUState -- FH.read/A.read

239+inspect $ 'copyStreamLatin1 `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe

240+inspect $ 'copyStreamLatin1 `hasNoType` ''Strict.Tuple3' -- FH.write/lchunksOf

241+#endif

242+

243+-- | Copy file

244+_copyStreamUtf8' :: Handle -> Handle -> IO ()

245+_copyStreamUtf8' inh outh =

246+ S.fold (FH.write outh)

247+ $ SS.encodeUtf8'

248+ $ SS.decodeUtf8'

249+ $ S.unfold FH.read inh

250+

251+#ifdef INSPECTION

252+inspect $ hasNoTypeClasses '_copyStreamUtf8'

253+-- inspect $ '_copyStreamUtf8 `hasNoType` ''Step

254+-- inspect $ '_copyStreamUtf8 `hasNoType` ''AT.FlattenState

255+-- inspect $ '_copyStreamUtf8 `hasNoType` ''D.ConcatMapUState

256+#endif

257+

258+-- | Copy file

259+copyStreamUtf8 :: Handle -> Handle -> IO ()

260+copyStreamUtf8 inh outh =

261+ S.fold (FH.write outh)

262+ $ SS.encodeUtf8

263+ $ SS.decodeUtf8

264+ $ S.unfold FH.read inh

265+

266+#ifdef INSPECTION

267+inspect $ hasNoTypeClasses 'copyStreamUtf8

268+-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''Step

269+-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''AT.FlattenState

270+-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''D.ConcatMapUState

271+#endif

272+

273+o_1_space_copy_read :: BenchEnv -> [Benchmark]

274+o_1_space_copy_read env =

275+ [ bgroup "copy/read"

276+ [-- mkBench "rawToNull" env $ \inh _ ->

277+ -- copyStream inh (nullH env)

278+ -- , mkBench "rawToFile" env $ \inh outh ->

279+ -- copyStream inh outh

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

281+ mkBench "SS.encodeLatin1' . SS.decodeLatin1" env $ \inh outh ->

282+ copyStreamLatin1' inh outh

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

284+ copyStreamLatin1 inh outh

285+#ifdef DEVBUILD

286+ , mkBench "copyUtf8" env $ \inh outh ->

287+ _copyStreamUtf8' inh outh

288+#endif

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

290+ copyStreamUtf8 inh outh

291+ ]

292+ ]

293+

294+main :: IO ()

295+main = do

296+ (_, cfg, benches) <- parseCLIOpts defaultStreamSize

297+ env <- mkBenchEnv "Benchmark_FileSystem_Handle_InputFile"

298+ runMode (mode cfg) cfg benches (allBenchmarks env)

299+

300+ where

301+

302+ allBenchmarks env =

303+ [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat $

304+ [ o_1_space_copy_chunked env

305+ , o_1_space_copy_read_group_ungroup env

306+ , o_1_space_copy_read env

307+ ]

308+ ]

benchmark/streamly-benchmarks.cabal+16

@@ -462,6 +462,22 @@ benchmark FileSystem.Handle

462 , directory >= 1.2.2 && < 1.4

463 , ghc-prim >= 0.4 && < 0.7

464

465+-------------------------------------------------------------------------------

466+-- Unicode Benchmarks

467+-------------------------------------------------------------------------------

468+benchmark Unicode.Stream

469+ import: bench-options

470+ type: exitcode-stdio-1.0

471+ ghc-options: +RTS -M3000M -RTS

472+ hs-source-dirs: . Streamly/Benchmark/Unicode

473+ main-is: Stream.hs

474+ other-modules:

475+ Streamly.Benchmark.CommonH

476+ build-depends:

477+ typed-process >= 0.2.3 && < 0.3

478+ , directory >= 1.2.2 && < 1.4

479+ , ghc-prim >= 0.4 && < 0.7

480+

465-------------------------------------------------------------------------------

481-------------------------------------------------------------------------------

466-- benchmark comparison and presentation

482-- benchmark comparison and presentation

467-------------------------------------------------------------------------------

483-------------------------------------------------------------------------------

streamly.cabal+2

@@ -109,6 +109,7 @@ extra-source-files:

109 bench.sh

110 benchmark/*.hs

111 benchmark/README.md

112+ benchmark/Streamly/Benchmark/CommonH.hs

112 benchmark/Streamly/Benchmark/Data/*.hs

113 benchmark/Streamly/Benchmark/Data/*.hs

113 benchmark/Streamly/Benchmark/Data/Parser/*.hs

114 benchmark/Streamly/Benchmark/Data/Parser/*.hs

114 benchmark/Streamly/Benchmark/Data/Stream/*.hs

115 benchmark/Streamly/Benchmark/Data/Stream/*.hs

@@ -116,6 +117,7 @@ extra-source-files:

116 benchmark/Streamly/Benchmark/FileSystem/Handle/*.hs

117 benchmark/Streamly/Benchmark/FileSystem/Handle/*.hs

117 benchmark/Streamly/Benchmark/Prelude/*.hs

118 benchmark/Streamly/Benchmark/Prelude/*.hs

118 benchmark/Streamly/Benchmark/Prelude/Serial/*.hs

119 benchmark/Streamly/Benchmark/Prelude/Serial/*.hs

120+ benchmark/Streamly/Benchmark/Unicode/*.hs

119 benchmark/lib/Streamly/Benchmark/*.hs

121 benchmark/lib/Streamly/Benchmark/*.hs

120 benchmark/streamly-benchmarks.cabal

122 benchmark/streamly-benchmarks.cabal

121 bin/bench-exec-one.sh

123 bin/bench-exec-one.sh