git.iko.soy/streamly
on master help sign in
Move group/ungroup benchmarks from FileSystem.Handle to Unicode.Stream, Add Unicode.Stream to bench.sh, Add Unicode and CommonH files to streamly.cabal
commitf7f8b0a6371ba27250b7e7df9f6a85257fc6b192 authorAnurag Hooda <anuraghooda@composewell.com> dateMon 7 Dec 2020, 11:00 (6 years ago) parent7f1b5d2
8 files changed+557−278
compare with master
unifiedsplit
bench.sh+1 benchmark/Streamly/Benchmark/FileSystem/Handle.hs−63 benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs−3 benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs+1−212 benchmark/Streamly/Benchmark/Prelude/Serial/Split.hs+229 benchmark/Streamly/Benchmark/Unicode/Stream.hs+308 benchmark/streamly-benchmarks.cabal+16 streamly.cabal+2
bench.sh+1
@@ -80,6 +80,7 @@ all_grp="\
8080 $prelude_concurrent_grp \
8181 $array_grp \
8282 $parser_grp \
83+ Unicode.Stream \
8384 Data.Unfold \
8485 FileSystem.Handle"
8586
benchmark/Streamly/Benchmark/FileSystem/Handle.hs−63
@@ -20,22 +20,14 @@
2020#endif
2121
2222#if __GLASGOW_HASKELL__ >= 800
23−import System.Directory (getFileSize)
2423#endif
25−import System.Environment (lookupEnv)
26−import System.IO (openFile, IOMode(..))
27−import System.Process.Typed (shell, runProcess_)
2824import Prelude hiding (last, length)
2925
3026import qualified Handle.ReadWrite as RW
3127import qualified Handle.Read as RO
3228
33−import Data.IORef
3429import Gauge hiding (env)
3530import Streamly.Benchmark.Common
36−-- TBD Change it to point to Common in parent directory
37−-- Done
38−-- import Handle.Common
3931import Streamly.Benchmark.CommonH
4032
4133-------------------------------------------------------------------------------
@@ -49,65 +41,10 @@ moduleName = "FileSystem.Handle"
4941--
5042-------------------------------------------------------------------------------
5143
52−-- smallFileSize :: Int
53−-- smallFileSize = 10 * 1024 * 1024
54−
55−-- bigFileSize :: Int
56−-- bigFileSize = 100 * 1024 * 1024
57−
58−-------------------------------------------------------------------------------
59−--
60−-------------------------------------------------------------------------------
61−
6244main :: IO ()
6345main = do
6446 (_, cfg, benches) <- parseCLIOpts defaultStreamSize
6547 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−
11148 runMode (mode cfg) cfg benches (allBenchmarks env)
11249
11350 where
benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs−3
@@ -23,7 +23,6 @@ module Handle.Read
2323 (allBenchmarks)
2424where
2525
26−import Data.Char (ord)
2726import Data.Functor.Identity (runIdentity)
2827import Data.Word (Word8)
2928import GHC.Magic (inline)
@@ -389,6 +388,4 @@ allBenchmarks env = Prelude.concat
389388 , o_1_space_reduce_read env
390389 , o_1_space_reduce_toBytes env
391390 , o_1_space_reduce_read_grouped env
392− -- , o_1_space_reduce_read_split env
393− -- , o_1_space_reduce_toChunks_split env
394391 ]
benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs+1−212
@@ -23,20 +23,14 @@ module Handle.ReadWrite
2323 (allBenchmarks)
2424where
2525
26−import Control.Exception (SomeException)
27−import System.IO (Handle, hClose, hPutChar)
26+import System.IO (Handle)
2827import Prelude hiding (last, length)
2928import Streamly.Internal.Data.Array.Storable.Foreign.Types (defaultChunkSize)
3029
31−import qualified Streamly.Data.Fold as FL
32−import qualified Streamly.Unicode.Stream as SS
3330import qualified Streamly.FileSystem.Handle as FH
3431import qualified Streamly.Internal.Data.Unfold as IUF
35−import qualified Streamly.Internal.Unicode.Stream as IUS
3632import qualified Streamly.Internal.FileSystem.Handle as IFH
3733import 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
4034import qualified Streamly.Data.Array.Storable.Foreign as A
4135import qualified Streamly.Prelude as S
4236
@@ -69,19 +63,6 @@ inspect $ hasNoTypeClasses 'copyChunks
6963inspect $ 'copyChunks `hasNoType` ''Step
7064#endif
7165
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−
8566o_1_space_copy_chunked :: BenchEnv -> [Benchmark]
8667o_1_space_copy_chunked env =
8768 [ bgroup "copy/toChunks"
@@ -89,8 +70,6 @@ o_1_space_copy_chunked env =
8970 copyChunks inH (nullH env)
9071 , mkBench "raw" env $ \inH outH ->
9172 copyChunks inH outH
92− , mkBenchSmall "decodeEncodeUtf8Lenient" env $ \inH outH ->
93− copyCodecUtf8ArraysLenient inH outH
9473 ]
9574 ]
9675
@@ -111,70 +90,6 @@ inspect $ 'copyStream `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
11190inspect $ 'copyStream `hasNoType` ''Strict.Tuple3' -- FH.write/lchunksOf
11291#endif
11392
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−
17893o_1_space_copy_read :: BenchEnv -> [Benchmark]
17994o_1_space_copy_read env =
18095 [ bgroup "copy/read"
@@ -182,17 +97,6 @@ o_1_space_copy_read env =
18297 copyStream inh (nullH env)
18398 , mkBench "rawToFile" env $ \inh outh ->
18499 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
196100 ]
197101 ]
198102
@@ -344,120 +248,6 @@ o_1_space_copy_toChunks_group_ungroup env =
344248 ]
345249 ]
346250
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− ]
461251
462252-------------------------------------------------------------------------------
463253--
@@ -470,5 +260,4 @@ allBenchmarks env = Prelude.concat
470260 , o_1_space_copy_fromBytes env
471261 , o_1_space_copy env
472262 , o_1_space_copy_toChunks_group_ungroup env
473− , o_1_space_copy_read_group_ungroup env
474263 ]
benchmark/Streamly/Benchmark/Prelude/Serial/Split.hsnew file+229
@@ -0,0 +1,229 @@
1+ -- |
2+-- Module : Streamly.Benchmark.Prelude.System.Split
3+-- Copyright : (c) 2019 Composewell Technologies
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+-- Stability : experimental
8+-- Portability : GHC
9+
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
3+-- Copyright : (c) 2019 Composewell Technologies
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+-- Stability : experimental
8+-- Portability : GHC
9+
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
462462 , directory >= 1.2.2 && < 1.4
463463 , ghc-prim >= 0.4 && < 0.7
464464
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+
465481-------------------------------------------------------------------------------
466482-- benchmark comparison and presentation
467483-------------------------------------------------------------------------------
streamly.cabal+2
@@ -109,6 +109,7 @@ extra-source-files:
109109 bench.sh
110110 benchmark/*.hs
111111 benchmark/README.md
112+ benchmark/Streamly/Benchmark/CommonH.hs
112113 benchmark/Streamly/Benchmark/Data/*.hs
113114 benchmark/Streamly/Benchmark/Data/Parser/*.hs
114115 benchmark/Streamly/Benchmark/Data/Stream/*.hs
@@ -116,6 +117,7 @@ extra-source-files:
116117 benchmark/Streamly/Benchmark/FileSystem/Handle/*.hs
117118 benchmark/Streamly/Benchmark/Prelude/*.hs
118119 benchmark/Streamly/Benchmark/Prelude/Serial/*.hs
120+ benchmark/Streamly/Benchmark/Unicode/*.hs
119121 benchmark/lib/Streamly/Benchmark/*.hs
120122 benchmark/streamly-benchmarks.cabal
121123 bin/bench-exec-one.sh