git.iko.soy/streamly
on master help sign in
Reorganize, move the FileIO benchmarks

Now they are in FileSystem.Handle module corresponding to the source module with the same name. Also, now we have them arranged based on space complexity so that we can apply RTS memory restrictions when running. Also, now longer benchmarks use a shorter file.

commit3d033ae9157e21771a78c12c0590d17bdff3577d authorHarendra Kumar <harendra@composewell.com> dateSun 5 Jul 2020, 13:24 (6 years ago) parentfa1bce3
6 files changed+1357−1281
compare with master
unifiedsplit
benchmark/FileIO.hs−349 benchmark/Streamly/Benchmark/FileIO/Array.hs−259 benchmark/Streamly/Benchmark/FileIO/Stream.hs−666 benchmark/Streamly/Benchmark/FileSystem/Handle.hs+1351 benchmark/streamly-benchmarks.cabal+5−6 streamly.cabal+1−1
benchmark/FileIO.hsdeleted−349
@@ -1,349 +0,0 @@
1−-- |
2−-- Module : Main
3−-- Copyright : (c) 2019 Harendra Kumar
4−--
5−-- License : BSD3
6−-- Maintainer : streamly@composewell.com
7−
8−{-# LANGUAGE CPP #-}
9−
10−import Control.DeepSeq (NFData)
11−import System.IO (openFile, IOMode(..), Handle, hClose)
12−import System.Process.Typed (shell, runProcess_)
13−
14−import Data.IORef
15−import Gauge
16−
17−import qualified Streamly.Benchmark.FileIO.Stream as BFS
18−import qualified Streamly.Benchmark.FileIO.Array as BFA
19−
20−-- Input and output file handles
21−data Handles = Handles Handle Handle
22−
23−scratchDir :: String
24−scratchDir = "benchmark/scratch/"
25−
26−outfile :: String
27−outfile = scratchDir ++ "out.txt"
28−
29−blockSize, blockCount :: Int
30−blockSize = 32768
31−blockCount = 3200
32−
33−fileSize :: Int
34−fileSize = blockSize * blockCount
35−
36−#ifdef DEVBUILD
37−-- This is a 500MB text file for text processing benchmarks. We cannot
38−-- have it in the repo, therefore we use it locally with DEVBUILD
39−-- conditional (enabled by "dev" cabal flag). Some tests that depend on
40−-- this file are available only in DEVBUILD mode.
41−infile :: String
42−infile = "benchmark/text-processing/gutenberg-500.txt"
43−
44−#else
45−infile :: String
46−infile = scratchDir ++ "in-100MB.txt"
47−#endif
48−
49−main :: IO ()
50−main = do
51−#ifndef DEVBUILD
52− -- XXX will this work on windows/msys?
53− let cmd = "mkdir -p " ++ scratchDir
54− ++ "; test -e " ++ infile
55− ++ " || { echo \"creating input file " ++ infile
56− ++ "\" && dd if=/dev/random of=" ++ infile
57− ++ " bs=" ++ show blockSize
58− ++ " count=" ++ show blockCount
59− ++ ";}"
60−
61− runProcess_ (shell cmd)
62−#endif
63− inHandle <- openFile infile ReadMode
64− outHandle <- openFile outfile WriteMode
65− href <- newIORef $ Handles inHandle outHandle
66− devNull <- openFile "/dev/null" WriteMode
67−
68− defaultMain
69− [ bgroup "readArray"
70− [ mkBench "last" href $ do
71− Handles inh _ <- readIORef href
72− BFA.last inh
73− -- Note: this cannot be fairly compared with GNU wc -c or wc -m as
74− -- wc uses lseek to just determine the file size rather than reading
75− -- and counting characters.
76− , mkBench "length (bytecount)" href $ do
77− Handles inh _ <- readIORef href
78− BFA.countBytes inh
79− , mkBench "linecount" href $ do
80− Handles inh _ <- readIORef href
81− BFA.countLines inh
82− , mkBench "wordcount" href $ do
83− Handles inh _ <- readIORef href
84− BFA.countWords inh
85− , mkBench "sum" href $ do
86− Handles inh _ <- readIORef href
87− BFA.sumBytes inh
88− , mkBench "cat" href $ do
89− Handles inh _ <- readIORef href
90− BFA.cat devNull inh
91− , mkBench "catBracket" href $ do
92− Handles inh _ <- readIORef href
93− BFA.catBracket devNull inh
94− , mkBench "catBracketIO" href $ do
95− Handles inh _ <- readIORef href
96− BFA.catBracketIO devNull inh
97− , mkBench "catBracketStream" href $ do
98− Handles inh _ <- readIORef href
99− BFA.catBracketStream devNull inh
100− , mkBench "catBracketStreamIO" href $ do
101− Handles inh _ <- readIORef href
102− BFA.catBracketStreamIO devNull inh
103− , mkBench "catOnException" href $ do
104− Handles inh _ <- readIORef href
105− BFA.catOnException devNull inh
106− , mkBench "read-utf8" href $ do
107− Handles inh _ <- readIORef href
108− BFA.decodeUtf8Lenient inh
109− ]
110− , bgroup "readStream"
111− [ mkBench "last" href $ do
112− Handles inh _ <- readIORef href
113− BFS.last inh
114− , mkBench "length (bytecount)" href $ do
115− Handles inh _ <- readIORef href
116− BFS.countBytes inh
117− , mkBench "linecount" href $ do
118− Handles inh _ <- readIORef href
119− BFS.countLines inh
120− , mkBench "linecountU" href $ do
121− Handles inh _ <- readIORef href
122− BFS.countLinesU inh
123− , mkBench "wordcount" href $ do
124− Handles inh _ <- readIORef href
125− BFS.countWords inh
126− , mkBench "sum" href $ do
127− Handles inh _ <- readIORef href
128− BFS.sumBytes inh
129− , mkBench "cat" href $ do
130− Handles inh _ <- readIORef href
131− BFS.cat devNull inh
132− , mkBench "catStream" href $ do
133− Handles inh _ <- readIORef href
134− BFS.catStreamWrite devNull inh
135−#ifdef DEVBUILD
136− , mkBench "catOnException" href $ do
137− Handles inh _ <- readIORef href
138− BFS.catOnException devNull inh
139− , mkBench "catOnExceptionStream" href $ do
140− Handles inh _ <- readIORef href
141− BFS.catOnExceptionStream devNull inh
142− , mkBench "catHandle" href $ do
143− Handles inh _ <- readIORef href
144− BFS.catHandle devNull inh
145− , mkBench "catHandleStream" href $ do
146− Handles inh _ <- readIORef href
147− BFS.catHandleStream devNull inh
148− , mkBench "catFinally" href $ do
149− Handles inh _ <- readIORef href
150− BFS.catFinally devNull inh
151− , mkBench "catFinallyIO" href $ do
152− Handles inh _ <- readIORef href
153− BFS.catFinallyIO devNull inh
154− , mkBench "catFinallyStream" href $ do
155− Handles inh _ <- readIORef href
156− BFS.catFinallyStream devNull inh
157− , mkBench "catFinallyStreamIO" href $ do
158− Handles inh _ <- readIORef href
159− BFS.catFinallyStreamIO devNull inh
160− , mkBench "catBracketStream" href $ do
161− Handles inh _ <- readIORef href
162− BFS.catBracketStream devNull inh
163− , mkBench "catBracketStreamIO" href $ do
164− Handles inh _ <- readIORef href
165− BFS.catBracketStreamIO devNull inh
166− , mkBench "catBracket" href $ do
167− Handles inh _ <- readIORef href
168− BFS.catBracket devNull inh
169− , mkBench "catBracketIO" href $ do
170− Handles inh _ <- readIORef href
171− BFS.catBracketIO devNull inh
172−#endif
173− , mkBench "read-word8" href $ do
174− Handles inh _ <- readIORef href
175− BFS.readWord8 inh
176− , mkBench "read-latin1" href $ do
177− Handles inh _ <- readIORef href
178− BFS.decodeLatin1 inh
179− , mkBench "read-utf8" href $ do
180− Handles inh _ <- readIORef href
181− BFS.decodeUtf8Lax inh
182− ]
183− , bgroup "copyArray"
184− [ mkBench "copy" href $ do
185− Handles inh outh <- readIORef href
186− BFA.copy inh outh
187− ]
188−#ifdef DEVBUILD
189− -- This takes a little longer therefore put under the dev conditional
190− , bgroup "copyStream"
191− [ mkBench "fromToHandle" href $ do
192− Handles inh outh <- readIORef href
193− BFS.copy inh outh
194− ]
195− -- This needs an ascii file, as decode just errors out.
196− , bgroup "decode-encode"
197− [ mkBench "latin1" href $ do
198− Handles inh outh <- readIORef href
199− BFS.copyCodecChar8 inh outh
200− , mkBench "utf8-arrays" href $ do
201− Handles inh outh <- readIORef href
202− BFA.copyCodecUtf8Lenient inh outh
203− , mkBench "utf8" href $ do
204− Handles inh outh <- readIORef href
205− BFS.copyCodecUtf8Lenient inh outh
206− ]
207−#endif
208− , bgroup "grouping-chunks"
209− [ mkBench "sumChunksOf (single chunk)" href $ do
210− Handles inh _ <- readIORef href
211− BFS.chunksOfSum fileSize inh
212− , mkBench "sumChunksOf 1" href $ do
213− Handles inh _ <- readIORef href
214− BFS.chunksOfSum 1 inh
215− , mkBench "sumChunksOf (single chunk) (parseMany)" href $ do
216− Handles inh _ <- readIORef href
217− BFS.parseManyChunksOfSum fileSize inh
218− , mkBench "sumChunksOf 1 (parseMany)" href $ do
219− Handles inh _ <- readIORef href
220− BFS.parseManyChunksOfSum 1 inh
221−
222− , mkBench "arraysOf 1" href $ do
223− Handles inh _ <- readIORef href
224− BFS.chunksOf 1 inh
225− , mkBench "arraysOf 10" href $ do
226− Handles inh _ <- readIORef href
227− BFS.chunksOf 10 inh
228− , mkBench "arraysOf 1000" href $ do
229− Handles inh _ <- readIORef href
230− BFS.chunksOf 1000 inh
231− ]
232−#ifdef DEVBUILD
233− , bgroup "group-ungroup-stream"
234− [ mkBench "lines-unlines-[Char]" href $ do
235− Handles inh outh <- readIORef href
236− BFS.linesUnlinesCopy inh outh
237− , mkBench "lines-unlines-Word8Array" href $ do
238− Handles inh outh <- readIORef href
239− BFS.linesUnlinesArrayWord8Copy inh outh
240− , mkBench "lines-unlines-CharArray" href $ do
241− Handles inh outh <- readIORef href
242− BFS.linesUnlinesArrayCharCopy inh outh
243− , mkBench "words-unwords-[Word8]" href $ do
244− Handles inh outh <- readIORef href
245− BFS.wordsUnwordsCopyWord8 inh outh
246− , mkBench "words-unwords-[Char]" href $ do
247− Handles inh outh <- readIORef href
248− BFS.wordsUnwordsCopy inh outh
249− , mkBench "words-unwords-CharArray" href $ do
250− Handles inh outh <- readIORef href
251− BFS.wordsUnwordsCharArrayCopy inh outh
252− ]
253−
254− , bgroup "group-ungroup-array-stream"
255− [ mkBench "lines-unlines-Word8Array" href $ do
256− Handles inh outh <- readIORef href
257− BFA.linesUnlinesCopy inh outh
258− , mkBench "words-unwords-Word8Array" href $ do
259− Handles inh outh <- readIORef href
260− BFA.wordsUnwordsCopy inh outh
261− ]
262−
263− , bgroup "splitting"
264− [ bgroup "predicate"
265− [ mkBench "splitOn \\n (line count)" href $ do
266− Handles inh _ <- readIORef href
267− BFS.splitOn inh
268− , mkBench "splitOnSuffix \\n (line count)" href $ do
269− Handles inh _ <- readIORef href
270− BFS.splitOnSuffix inh
271− , mkBench "splitOn \\n (line count) (parseMany)" href $ do
272− Handles inh _ <- readIORef href
273− BFS.parseManySepBy inh
274− , mkBench "wordsBy isSpace (word count)" href $ do
275− Handles inh _ <- readIORef href
276− BFS.wordsBy inh
277− ]
278−
279− , bgroup "empty-pattern"
280− [ mkBench "splitOnSeq \"\"" href $ do
281− Handles inh _ <- readIORef href
282− BFS.splitOnSeq "" inh
283− , mkBench "splitOnSuffixSeq \"\"" href $ do
284− Handles inh _ <- readIORef href
285− BFS.splitOnSuffixSeq "" inh
286− ]
287− , bgroup "short-pattern"
288− [ mkBench "splitOnSeq \\n (line count)" href $ do
289− Handles inh _ <- readIORef href
290− BFS.splitOnSeq "\n" inh
291− , mkBench "splitOnSuffixSeq \\n (line count)" href $ do
292− Handles inh _ <- readIORef href
293− BFS.splitOnSuffixSeq "\n" inh
294− , mkBench "splitOnSeq a" href $ do
295− Handles inh _ <- readIORef href
296− BFS.splitOnSeq "a" inh
297− , mkBench "splitOnSeq \\r\\n" href $ do
298− Handles inh _ <- readIORef href
299− BFS.splitOnSeq "\r\n" inh
300− , mkBench "splitOnSuffixSeq \\r\\n)" href $ do
301− Handles inh _ <- readIORef href
302− BFS.splitOnSuffixSeq "\r\n" inh
303− , mkBench "splitOnSeq aa" href $ do
304− Handles inh _ <- readIORef href
305− BFS.splitOnSeq "aa" inh
306− , mkBench "splitOnSeq aaaa" href $ do
307− Handles inh _ <- readIORef href
308− BFS.splitOnSeq "aaaa" inh
309− , mkBench "splitOnSeq abcdefgh" href $ do
310− Handles inh _ <- readIORef href
311− BFS.splitOnSeq "abcdefgh" inh
312− , mkBench "splitOnSeqUtf8 abcdefgh" href $ do
313− Handles inh _ <- readIORef href
314− BFS.splitOnSeqUtf8 "abcdefgh" inh
315− ]
316− , bgroup "long-pattern"
317− [ mkBench "splitOnSeq abcdefghi" href $ do
318− Handles inh _ <- readIORef href
319− BFS.splitOnSeq "abcdefghi" inh
320− , mkBench "splitOnSeq catcatcatcatcat" href $ do
321− Handles inh _ <- readIORef href
322− BFS.splitOnSeq "catcatcatcatcat" inh
323− , mkBench "splitOnSeq abc...xyz" href $ do
324− Handles inh _ <- readIORef href
325− BFS.splitOnSeq "abcdefghijklmnopqrstuvwxyz" inh
326− , mkBench "splitOnSuffixSeq abc...xyz" href $ do
327− Handles inh _ <- readIORef href
328− BFS.splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh
329− , mkBench "splitOnSeqUtf8 abc...xyz" href $ do
330− Handles inh _ <- readIORef href
331− BFS.splitOnSeqUtf8 "abcdefghijklmnopqrstuvwxyz" inh
332− ]
333− ]
334−#endif
335− ]
336−
337− where
338−
339− mkBench :: NFData b => String -> IORef Handles -> IO b -> Benchmark
340− mkBench name ref action =
341− bench name $ perRunEnv (do
342− (Handles inh outh) <- readIORef ref
343− hClose inh
344− hClose outh
345− inHandle <- openFile infile ReadMode
346− outHandle <- openFile outfile WriteMode
347− writeIORef ref (Handles inHandle outHandle)
348− )
349− (\_ -> action)
benchmark/Streamly/Benchmark/FileIO/Array.hsdeleted−259
@@ -1,259 +0,0 @@
1−-- |
2−-- Module : Streamly.Benchmark.FileIO.Array
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−
12−#ifdef __HADDOCK_VERSION__
13−#undef INSPECTION
14−#endif
15−
16−#ifdef INSPECTION
17−{-# LANGUAGE TemplateHaskell #-}
18−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19−#endif
20−
21−module Streamly.Benchmark.FileIO.Array
22− (
23− last
24− , countBytes
25− , countLines
26− , countWords
27− , sumBytes
28− , cat
29− , catOnException
30− , catBracket
31− , catBracketIO
32− , catBracketStream
33− , catBracketStreamIO
34− , copy
35− , linesUnlinesCopy
36− , wordsUnwordsCopy
37− , decodeUtf8Lenient
38− , copyCodecUtf8Lenient
39− )
40−where
41−
42−import Data.Functor.Identity (runIdentity)
43−import Data.Word (Word8)
44−import System.IO (Handle, hClose)
45−import Prelude hiding (last)
46−
47−import qualified Streamly.FileSystem.Handle as FH
48−import qualified Streamly.Memory.Array as A
49−import qualified Streamly.Prelude as S
50−import qualified Streamly.Data.Unicode.Stream as SS
51−import qualified Streamly.Internal.Data.Unicode.Stream as IUS
52−
53−import qualified Streamly.Internal.FileSystem.Handle as IFH
54−import qualified Streamly.Internal.Memory.Array as IA
55−import qualified Streamly.Internal.Memory.ArrayStream as AS
56−import qualified Streamly.Internal.Data.Unfold as IUF
57−import qualified Streamly.Internal.Prelude as IP
58−
59−#ifdef INSPECTION
60−import Foreign.Storable (Storable)
61−import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
62−import Test.Inspection
63−#endif
64−
65−-- | Get the last byte from a file bytestream.
66−{-# INLINE last #-}
67−last :: Handle -> IO (Maybe Word8)
68−last inh = do
69− let s = IFH.toChunks inh
70− larr <- S.last s
71− return $ case larr of
72− Nothing -> Nothing
73− Just arr -> IA.readIndex arr (A.length arr - 1)
74−
75−#ifdef INSPECTION
76−inspect $ hasNoTypeClasses 'last
77−inspect $ 'last `hasNoType` ''Step
78−#endif
79−
80−-- | Count the number of bytes in a file.
81−{-# INLINE countBytes #-}
82−countBytes :: Handle -> IO Int
83−countBytes inh =
84− let s = IFH.toChunks inh
85− in S.sum (S.map A.length s)
86−
87−#ifdef INSPECTION
88−inspect $ hasNoTypeClasses 'countBytes
89−inspect $ 'countBytes `hasNoType` ''Step
90−#endif
91−
92−-- | Count the number of lines in a file.
93−{-# INLINE countLines #-}
94−countLines :: Handle -> IO Int
95−countLines = S.length . AS.splitOnSuffix 10 . IFH.toChunks
96−
97−#ifdef INSPECTION
98−inspect $ hasNoTypeClasses 'countLines
99−inspect $ 'countLines `hasNoType` ''Step
100−#endif
101−
102−-- XXX use a word splitting combinator instead of splitOn and test it.
103−-- | Count the number of lines in a file.
104−{-# INLINE countWords #-}
105−countWords :: Handle -> IO Int
106−countWords = S.length . AS.splitOn 32 . IFH.toChunks
107−
108−#ifdef INSPECTION
109−inspect $ hasNoTypeClasses 'countWords
110−inspect $ 'countWords `hasNoType` ''Step
111−#endif
112−
113−-- | Sum the bytes in a file.
114−{-# INLINE sumBytes #-}
115−sumBytes :: Handle -> IO Word8
116−sumBytes inh = do
117− let foldlArr' f z = runIdentity . S.foldl' f z . IA.toStream
118− let s = IFH.toChunks inh
119− S.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
120−
121−#ifdef INSPECTION
122−inspect $ hasNoTypeClasses 'sumBytes
123−inspect $ 'sumBytes `hasNoType` ''Step
124−#endif
125−
126−-- | Send the file contents to /dev/null
127−{-# INLINE cat #-}
128−cat :: Handle -> Handle -> IO ()
129−cat devNull inh =
130− S.fold (IFH.writeChunks devNull) $ IFH.toChunksWithBufferOf (256*1024) inh
131−
132−#ifdef INSPECTION
133−inspect $ hasNoTypeClasses 'cat
134−inspect $ 'cat `hasNoType` ''Step
135−#endif
136−
137−-- | Send the file contents to /dev/null with exception handling
138−{-# INLINE catBracket #-}
139−catBracket :: Handle -> Handle -> IO ()
140−catBracket devNull inh =
141− let readEx = IUF.bracket return (\_ -> hClose inh)
142− (IUF.supplyFirst FH.readChunksWithBufferOf (256*1024))
143− in IUF.fold readEx (IFH.writeChunks devNull) inh
144−
145−#ifdef INSPECTION
146−inspect $ hasNoTypeClasses 'catBracket
147−-- inspect $ 'catBracket `hasNoType` ''Step
148−#endif
149−
150−{-# INLINE catBracketIO #-}
151−catBracketIO :: Handle -> Handle -> IO ()
152−catBracketIO devNull inh =
153− let readEx = IUF.bracketIO return (\_ -> hClose inh)
154− (IUF.supplyFirst FH.readChunksWithBufferOf (256*1024))
155− in IUF.fold readEx (IFH.writeChunks devNull) inh
156−
157−-- | Send the file contents to /dev/null with exception handling
158−{-# INLINE catBracketStream #-}
159−catBracketStream :: Handle -> Handle -> IO ()
160−catBracketStream devNull inh =
161− let readEx = S.bracket (return ()) (\_ -> hClose inh)
162− (\_ -> IFH.toChunksWithBufferOf (256*1024) inh)
163− in S.fold (IFH.writeChunks devNull) $ readEx
164−
165−#ifdef INSPECTION
166−inspect $ hasNoTypeClasses 'catBracketStream
167−-- inspect $ 'catBracketStream `hasNoType` ''Step
168−#endif
169−
170−{-# INLINE catBracketStreamIO #-}
171−catBracketStreamIO :: Handle -> Handle -> IO ()
172−catBracketStreamIO devNull inh =
173− let readEx = IP.bracketIO (return ()) (\_ -> hClose inh)
174− (\_ -> IFH.toChunksWithBufferOf (256*1024) inh)
175− in S.fold (IFH.writeChunks devNull) $ readEx
176−
177−-- | Send the file contents to /dev/null with exception handling
178−{-# INLINE catOnException #-}
179−catOnException :: Handle -> Handle -> IO ()
180−catOnException devNull inh =
181− let readEx = IUF.onException (\_ -> hClose inh)
182− (IUF.supplyFirst FH.readChunksWithBufferOf (256*1024))
183− in IUF.fold readEx (IFH.writeChunks devNull) inh
184−
185−#ifdef INSPECTION
186−inspect $ hasNoTypeClasses 'catOnException
187−-- inspect $ 'catOnException `hasNoType` ''Step
188−#endif
189−
190−-- | Copy file
191−{-# INLINE copy #-}
192−copy :: Handle -> Handle -> IO ()
193−copy inh outh =
194− let s = IFH.toChunks inh
195− in S.fold (IFH.writeChunks outh) s
196−
197−#ifdef INSPECTION
198−inspect $ hasNoTypeClasses 'copy
199−inspect $ 'copy `hasNoType` ''Step
200−#endif
201−
202−-- | Lines and unlines
203−{-# INLINE linesUnlinesCopy #-}
204−linesUnlinesCopy :: Handle -> Handle -> IO ()
205−linesUnlinesCopy inh outh =
206− S.fold (IFH.writeWithBufferOf (1024*1024) outh)
207− $ AS.interposeSuffix 10
208− $ AS.splitOnSuffix 10
209− $ IFH.toChunksWithBufferOf (1024*1024) inh
210−
211−#ifdef INSPECTION
212−inspect $ hasNoTypeClassesExcept 'linesUnlinesCopy [''Storable]
213−-- inspect $ 'linesUnlinesCopy `hasNoType` ''Step
214−#endif
215−
216−-- | Words and unwords
217−{-# INLINE wordsUnwordsCopy #-}
218−wordsUnwordsCopy :: Handle -> Handle -> IO ()
219−wordsUnwordsCopy inh outh =
220− S.fold (IFH.writeWithBufferOf (1024*1024) outh)
221− $ AS.interpose 32
222− -- XXX this is not correct word splitting combinator
223− $ AS.splitOn 32
224− $ IFH.toChunksWithBufferOf (1024*1024) inh
225−
226−#ifdef INSPECTION
227−inspect $ hasNoTypeClassesExcept 'wordsUnwordsCopy [''Storable]
228−-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step
229−#endif
230−
231−{-# INLINE decodeUtf8Lenient #-}
232−decodeUtf8Lenient :: Handle -> IO ()
233−decodeUtf8Lenient inh =
234− S.drain
235− $ IUS.decodeUtf8ArraysLenient
236− $ IFH.toChunksWithBufferOf (1024*1024) inh
237−
238−#ifdef INSPECTION
239−inspect $ hasNoTypeClasses 'decodeUtf8Lenient
240−-- inspect $ 'decodeUtf8Lenient `hasNoType` ''Step
241−-- inspect $ 'decodeUtf8Lenient `hasNoType` ''AT.FlattenState
242−-- inspect $ 'decodeUtf8Lenient `hasNoType` ''D.ConcatMapUState
243−#endif
244−
245−-- | Copy file
246−{-# INLINE copyCodecUtf8Lenient #-}
247−copyCodecUtf8Lenient :: Handle -> Handle -> IO ()
248−copyCodecUtf8Lenient inh outh =
249− S.fold (FH.write outh)
250− $ SS.encodeUtf8
251− $ IUS.decodeUtf8ArraysLenient
252− $ IFH.toChunksWithBufferOf (1024*1024) inh
253−
254−#ifdef INSPECTION
255−inspect $ hasNoTypeClasses 'copyCodecUtf8Lenient
256−-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''Step
257−-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''AT.FlattenState
258−-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''D.ConcatMapUState
259−#endif
benchmark/Streamly/Benchmark/FileIO/Stream.hsdeleted−666
@@ -1,666 +0,0 @@
1−-- |
2−-- Module : Streamly.Benchmark.FileIO.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−module Streamly.Benchmark.FileIO.Stream
23− (
24− -- * FileIO
25− last
26− , countBytes
27− , countLines
28− , countLinesU
29− , countWords
30− , sumBytes
31− , cat
32− , catStreamWrite
33− , catBracket
34− , catBracketIO
35− , catBracketStream
36− , catBracketStreamIO
37− , catOnException
38− , catOnExceptionStream
39− , catHandle
40− , catHandleStream
41− , catFinally
42− , catFinallyIO
43− , catFinallyStream
44− , catFinallyStreamIO
45− , copy
46− , linesUnlinesCopy
47− , linesUnlinesArrayWord8Copy
48− , linesUnlinesArrayCharCopy
49− -- , linesUnlinesArrayUtf8Copy
50− , wordsUnwordsCopyWord8
51− , wordsUnwordsCopy
52− , wordsUnwordsCharArrayCopy
53− , readWord8
54− , decodeLatin1
55− , copyCodecChar8
56− , copyCodecUtf8
57− , decodeUtf8Lax
58− , copyCodecUtf8Lenient
59− , chunksOfSum
60− , parseManyChunksOfSum
61− , chunksOf
62− , chunksOfD
63− , splitOn
64− , splitOnSuffix
65− , parseManySepBy
66− , wordsBy
67− , splitOnSeq
68− , splitOnSeqUtf8
69− , splitOnSuffixSeq
70− )
71−where
72−
73−import Control.Exception (SomeException)
74−import Data.Char (ord, chr)
75−import Data.Word (Word8)
76−import System.IO (Handle, hClose)
77−import Prelude hiding (last, length)
78−
79−import qualified Streamly.FileSystem.Handle as FH
80−import qualified Streamly.Internal.FileSystem.Handle as IFH
81−import qualified Streamly.Memory.Array as A
82−-- import qualified Streamly.Internal.Memory.Array as IA
83−import qualified Streamly.Internal.Memory.Array.Types as AT
84−import qualified Streamly.Prelude as S
85−import qualified Streamly.Data.Fold as FL
86−-- import qualified Streamly.Internal.Data.Fold as IFL
87−import qualified Streamly.Data.Unicode.Stream as SS
88−import qualified Streamly.Internal.Data.Unicode.Stream as IUS
89−import qualified Streamly.Internal.Memory.Unicode.Array as IUA
90−import qualified Streamly.Internal.Data.Unfold as IUF
91−import qualified Streamly.Internal.Data.Parser as PR
92−import qualified Streamly.Internal.Prelude as IP
93−import qualified Streamly.Internal.Data.Stream.StreamD as D
94−
95−#ifdef INSPECTION
96−import Foreign.Storable (Storable)
97−import Streamly.Internal.Data.Stream.StreamD.Type (Step(..), GroupState)
98−import Test.Inspection
99−#endif
100−
101−-- | Get the last byte from a file bytestream.
102−{-# INLINE last #-}
103−last :: Handle -> IO (Maybe Word8)
104−last = S.last . S.unfold FH.read
105−
106−#ifdef INSPECTION
107−inspect $ hasNoTypeClasses 'last
108−inspect $ 'last `hasNoType` ''Step
109−inspect $ 'last `hasNoType` ''AT.FlattenState
110−inspect $ 'last `hasNoType` ''D.ConcatMapUState
111−#endif
112−
113−-- assert that flattenArrays constructors are not present
114−-- | Count the number of bytes in a file.
115−{-# INLINE countBytes #-}
116−countBytes :: Handle -> IO Int
117−countBytes = S.length . S.unfold FH.read
118−
119−#ifdef INSPECTION
120−inspect $ hasNoTypeClasses 'countBytes
121−inspect $ 'countBytes `hasNoType` ''Step
122−inspect $ 'countBytes `hasNoType` ''AT.FlattenState
123−inspect $ 'countBytes `hasNoType` ''D.ConcatMapUState
124−#endif
125−
126−-- | Count the number of lines in a file.
127−{-# INLINE countLines #-}
128−countLines :: Handle -> IO Int
129−countLines =
130− S.length
131− . IUS.lines FL.drain
132− . SS.decodeLatin1
133− . S.unfold FH.read
134−
135−#ifdef INSPECTION
136−inspect $ hasNoTypeClasses 'countLines
137−inspect $ 'countLines `hasNoType` ''Step
138−inspect $ 'countLines `hasNoType` ''AT.FlattenState
139−inspect $ 'countLines `hasNoType` ''D.ConcatMapUState
140−#endif
141−
142−-- | Count the number of words in a file.
143−{-# INLINE countWords #-}
144−countWords :: Handle -> IO Int
145−countWords =
146− S.length
147− . IUS.words FL.drain
148− . SS.decodeLatin1
149− . S.unfold FH.read
150−
151−#ifdef INSPECTION
152−inspect $ hasNoTypeClasses 'countWords
153−-- inspect $ 'countWords `hasNoType` ''Step
154−-- inspect $ 'countWords `hasNoType` ''D.ConcatMapUState
155−#endif
156−
157−-- | Count the number of lines in a file.
158−{-# INLINE countLinesU #-}
159−countLinesU :: Handle -> IO Int
160−countLinesU inh =
161− S.length
162− $ IUS.lines FL.drain
163− $ SS.decodeLatin1
164− $ S.concatUnfold A.read (IFH.toChunks inh)
165−
166−#ifdef INSPECTION
167−inspect $ hasNoTypeClasses 'countLinesU
168−inspect $ 'countLinesU `hasNoType` ''Step
169−inspect $ 'countLinesU `hasNoType` ''D.ConcatMapUState
170−#endif
171−
172−-- | Sum the bytes in a file.
173−{-# INLINE sumBytes #-}
174−sumBytes :: Handle -> IO Word8
175−sumBytes = S.sum . S.unfold FH.read
176−
177−#ifdef INSPECTION
178−inspect $ hasNoTypeClasses 'sumBytes
179−inspect $ 'sumBytes `hasNoType` ''Step
180−inspect $ 'sumBytes `hasNoType` ''AT.FlattenState
181−inspect $ 'sumBytes `hasNoType` ''D.ConcatMapUState
182−#endif
183−
184−-- | Send the file contents to /dev/null
185−{-# INLINE cat #-}
186−cat :: Handle -> Handle -> IO ()
187−cat devNull inh = S.fold (FH.write devNull) $ S.unfold FH.read inh
188−
189−#ifdef INSPECTION
190−inspect $ hasNoTypeClasses 'cat
191−inspect $ 'cat `hasNoType` ''Step
192−inspect $ 'cat `hasNoType` ''AT.FlattenState
193−inspect $ 'cat `hasNoType` ''D.ConcatMapUState
194−#endif
195−
196−-- | Send the file contents to /dev/null
197−{-# INLINE catStreamWrite #-}
198−catStreamWrite :: Handle -> Handle -> IO ()
199−catStreamWrite devNull inh = IFH.fromBytes devNull $ S.unfold FH.read inh
200−
201−#ifdef INSPECTION
202−inspect $ hasNoTypeClasses 'catStreamWrite
203−inspect $ 'catStreamWrite `hasNoType` ''Step
204−inspect $ 'catStreamWrite `hasNoType` ''AT.FlattenState
205−inspect $ 'catStreamWrite `hasNoType` ''D.ConcatMapUState
206−#endif
207−
208−-- | Send the file contents to /dev/null with exception handling
209−{-# INLINE catBracket #-}
210−catBracket :: Handle -> Handle -> IO ()
211−catBracket devNull inh =
212− let readEx = IUF.bracket return (\_ -> hClose inh) FH.read
213− in S.fold (FH.write devNull) $ S.unfold readEx inh
214−
215−#ifdef INSPECTION
216−inspect $ hasNoTypeClasses 'catBracket
217−-- inspect $ 'catBracket `hasNoType` ''Step
218−-- inspect $ 'catBracket `hasNoType` ''AT.FlattenState
219−-- inspect $ 'catBracket `hasNoType` ''D.ConcatMapUState
220−#endif
221−
222−{-# INLINE catBracketIO #-}
223−catBracketIO :: Handle -> Handle -> IO ()
224−catBracketIO devNull inh =
225− let readEx = IUF.bracketIO return (\_ -> hClose inh) FH.read
226− in S.fold (FH.write devNull) $ S.unfold readEx inh
227−
228−-- | Send the file contents to /dev/null with exception handling
229−{-# INLINE catBracketStream #-}
230−catBracketStream :: Handle -> Handle -> IO ()
231−catBracketStream devNull inh =
232− let readEx = S.bracket (return ()) (\_ -> hClose inh)
233− (\_ -> IFH.toBytes inh)
234− in IFH.fromBytes devNull $ readEx
235−
236−#ifdef INSPECTION
237−inspect $ hasNoTypeClasses 'catBracketStream
238−-- inspect $ 'catBracketStream `hasNoType` ''Step
239−#endif
240−
241−{-# INLINE catBracketStreamIO #-}
242−catBracketStreamIO :: Handle -> Handle -> IO ()
243−catBracketStreamIO devNull inh =
244− let readEx = IP.bracketIO (return ()) (\_ -> hClose inh)
245− (\_ -> IFH.toBytes inh)
246− in IFH.fromBytes devNull $ readEx
247−
248−-- | Send the file contents to /dev/null with exception handling
249−{-# INLINE catOnException #-}
250−catOnException :: Handle -> Handle -> IO ()
251−catOnException devNull inh =
252− let readEx = IUF.onException (\_ -> hClose inh) FH.read
253− in S.fold (FH.write devNull) $ S.unfold readEx inh
254−
255−#ifdef INSPECTION
256−inspect $ hasNoTypeClasses 'catOnException
257−-- inspect $ 'catOnException `hasNoType` ''Step
258−-- inspect $ 'catOnException `hasNoType` ''AT.FlattenState
259−-- inspect $ 'catOnException `hasNoType` ''D.ConcatMapUState
260−#endif
261−
262−-- | Send the file contents to /dev/null with exception handling
263−{-# INLINE catOnExceptionStream #-}
264−catOnExceptionStream :: Handle -> Handle -> IO ()
265−catOnExceptionStream devNull inh =
266− let readEx = S.onException (hClose inh) (S.unfold FH.read inh)
267− in S.fold (FH.write devNull) $ readEx
268−
269−-- | Send the file contents to /dev/null with exception handling
270−{-# INLINE catFinally #-}
271−catFinally :: Handle -> Handle -> IO ()
272−catFinally devNull inh =
273− let readEx = IUF.finally (\_ -> hClose inh) FH.read
274− in S.fold (FH.write devNull) $ S.unfold readEx inh
275−
276−#ifdef INSPECTION
277−inspect $ hasNoTypeClasses 'catFinally
278−-- inspect $ 'catFinally `hasNoType` ''Step
279−-- inspect $ 'catFinally `hasNoType` ''AT.FlattenState
280−-- inspect $ 'catFinally `hasNoType` ''D.ConcatMapUState
281−#endif
282−
283−{-# INLINE catFinallyIO #-}
284−catFinallyIO :: Handle -> Handle -> IO ()
285−catFinallyIO devNull inh =
286− let readEx = IUF.finallyIO (\_ -> hClose inh) FH.read
287− in S.fold (FH.write devNull) $ S.unfold readEx inh
288−
289−-- | Send the file contents to /dev/null with exception handling
290−{-# INLINE catFinallyStream #-}
291−catFinallyStream :: Handle -> Handle -> IO ()
292−catFinallyStream devNull inh =
293− let readEx = S.finally (hClose inh) (S.unfold FH.read inh)
294− in S.fold (FH.write devNull) readEx
295−
296−{-# INLINE catFinallyStreamIO #-}
297−catFinallyStreamIO :: Handle -> Handle -> IO ()
298−catFinallyStreamIO devNull inh =
299− let readEx = IP.finallyIO (hClose inh) (S.unfold FH.read inh)
300− in S.fold (FH.write devNull) readEx
301−
302−-- | Send the file contents to /dev/null with exception handling
303−{-# INLINE catHandle #-}
304−catHandle :: Handle -> Handle -> IO ()
305−catHandle devNull inh =
306− let handler (_e :: SomeException) = hClose inh >> return 10
307− readEx = IUF.handle (IUF.singletonM handler) FH.read
308− in S.fold (FH.write devNull) $ S.unfold readEx inh
309−
310−#ifdef INSPECTION
311−inspect $ hasNoTypeClasses 'catHandle
312−-- inspect $ 'catHandle `hasNoType` ''Step
313−-- inspect $ 'catHandle `hasNoType` ''AT.FlattenState
314−-- inspect $ 'catHandle `hasNoType` ''D.ConcatMapUState
315−#endif
316−
317−-- | Send the file contents to /dev/null with exception handling
318−{-# INLINE catHandleStream #-}
319−catHandleStream :: Handle -> Handle -> IO ()
320−catHandleStream devNull inh =
321− let handler (_e :: SomeException) = S.yieldM (hClose inh >> return 10)
322− readEx = S.handle handler (S.unfold FH.read inh)
323− in S.fold (FH.write devNull) $ readEx
324−
325−-- | Copy file
326−{-# INLINE copy #-}
327−copy :: Handle -> Handle -> IO ()
328−copy inh outh = S.fold (FH.write outh) (S.unfold FH.read inh)
329−
330−#ifdef INSPECTION
331−inspect $ hasNoTypeClasses 'copy
332−inspect $ 'copy `hasNoType` ''Step
333−inspect $ 'copy `hasNoType` ''AT.FlattenState
334−inspect $ 'copy `hasNoType` ''D.ConcatMapUState
335−#endif
336−
337−{-# INLINE readWord8 #-}
338−readWord8 :: Handle -> IO ()
339−readWord8 inh = S.drain $ S.unfold FH.read inh
340−
341−{-# INLINE decodeLatin1 #-}
342−decodeLatin1 :: Handle -> IO ()
343−decodeLatin1 inh =
344− S.drain
345− $ SS.decodeLatin1
346− $ S.unfold FH.read inh
347−
348−-- | Copy file
349−{-# INLINE copyCodecChar8 #-}
350−copyCodecChar8 :: Handle -> Handle -> IO ()
351−copyCodecChar8 inh outh =
352− S.fold (FH.write outh)
353− $ SS.encodeLatin1
354− $ SS.decodeLatin1
355− $ S.unfold FH.read inh
356−
357−#ifdef INSPECTION
358−inspect $ hasNoTypeClasses 'copyCodecChar8
359−inspect $ 'copyCodecChar8 `hasNoType` ''Step
360−inspect $ 'copyCodecChar8 `hasNoType` ''AT.FlattenState
361−inspect $ 'copyCodecChar8 `hasNoType` ''D.ConcatMapUState
362−#endif
363−
364−{-# INLINE decodeUtf8Lax #-}
365−decodeUtf8Lax :: Handle -> IO ()
366−decodeUtf8Lax inh =
367− S.drain
368− $ SS.decodeUtf8Lax
369− $ S.unfold FH.read inh
370−
371−#ifdef INSPECTION
372−inspect $ hasNoTypeClasses 'decodeUtf8Lax
373−-- inspect $ 'decodeUtf8Lax `hasNoType` ''Step
374−-- inspect $ 'decodeUtf8Lax `hasNoType` ''AT.FlattenState
375−-- inspect $ 'decodeUtf8Lax `hasNoType` ''D.ConcatMapUState
376−#endif
377−
378−-- | Copy file
379−{-# INLINE copyCodecUtf8 #-}
380−copyCodecUtf8 :: Handle -> Handle -> IO ()
381−copyCodecUtf8 inh outh =
382− S.fold (FH.write outh)
383− $ SS.encodeUtf8
384− $ SS.decodeUtf8
385− $ S.unfold FH.read inh
386−
387−#ifdef INSPECTION
388−inspect $ hasNoTypeClasses 'copyCodecUtf8
389−-- inspect $ 'copyCodecUtf8 `hasNoType` ''Step
390−-- inspect $ 'copyCodecUtf8 `hasNoType` ''AT.FlattenState
391−-- inspect $ 'copyCodecUtf8 `hasNoType` ''D.ConcatMapUState
392−#endif
393−
394−-- | Copy file
395−{-# INLINE copyCodecUtf8Lenient #-}
396−copyCodecUtf8Lenient :: Handle -> Handle -> IO ()
397−copyCodecUtf8Lenient inh outh =
398− S.fold (FH.write outh)
399− $ SS.encodeUtf8
400− $ SS.decodeUtf8Lax
401− $ S.unfold FH.read inh
402−
403−#ifdef INSPECTION
404−inspect $ hasNoTypeClasses 'copyCodecUtf8Lenient
405−-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''Step
406−-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''AT.FlattenState
407−-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''D.ConcatMapUState
408−#endif
409−
410−{-# INLINE chunksOfSum #-}
411−chunksOfSum :: Int -> Handle -> IO Int
412−chunksOfSum n inh = S.length $ S.chunksOf n FL.sum (S.unfold FH.read inh)
413−
414−-- | Slice in chunks of size n and get the count of chunks.
415−{-# INLINE chunksOf #-}
416−chunksOf :: Int -> Handle -> IO Int
417−chunksOf n inh =
418− -- writeNUnsafe gives 2.5x boost here over writeN.
419− S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.read inh)
420−
421−#ifdef INSPECTION
422−inspect $ hasNoTypeClasses 'chunksOf
423−inspect $ 'chunksOf `hasNoType` ''Step
424−inspect $ 'chunksOf `hasNoType` ''AT.FlattenState
425−inspect $ 'chunksOf `hasNoType` ''D.ConcatMapUState
426−inspect $ 'chunksOf `hasNoType` ''GroupState
427−#endif
428−
429−-- This is to make sure that the concatMap in FH.read, groupsOf and foldlM'
430−-- together can fuse.
431−--
432−-- | Slice in chunks of size n and get the count of chunks.
433−{-# INLINE chunksOfD #-}
434−chunksOfD :: Int -> Handle -> IO Int
435−chunksOfD n inh =
436− D.foldlM' (\i _ -> return $ i + 1) (return 0)
437− $ D.groupsOf n (AT.writeNUnsafe n)
438− $ D.fromStreamK (S.unfold FH.read inh)
439−
440−#ifdef INSPECTION
441−inspect $ hasNoTypeClasses 'chunksOf
442−inspect $ 'chunksOf `hasNoType` ''Step
443−inspect $ 'chunksOfD `hasNoType` ''GroupState
444−inspect $ 'chunksOfD `hasNoType` ''AT.FlattenState
445−inspect $ 'chunksOfD `hasNoType` ''D.ConcatMapUState
446−#endif
447−
448−{-# INLINE parseManyChunksOfSum #-}
449−parseManyChunksOfSum :: Int -> Handle -> IO Int
450−parseManyChunksOfSum n inh =
451− S.length $ IP.parseMany (PR.take n FL.sum) (S.unfold FH.read inh)
452−
453−{-# INLINE linesUnlinesCopy #-}
454−linesUnlinesCopy :: Handle -> Handle -> IO ()
455−linesUnlinesCopy inh outh =
456− S.fold (FH.write outh)
457− $ SS.encodeLatin1
458− $ IUS.unlines IUF.fromList
459− $ S.splitOnSuffix (== '\n') FL.toList
460− $ SS.decodeLatin1
461− $ S.unfold FH.read inh
462−
463−{-# INLINE linesUnlinesArrayWord8Copy #-}
464−linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO ()
465−linesUnlinesArrayWord8Copy inh outh =
466− S.fold (FH.write outh)
467− $ IP.interposeSuffix 10 A.read
468− $ S.splitOnSuffix (== 10) A.write
469− $ S.unfold FH.read inh
470−
471−-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion
472−-- | Lines and unlines
473−{-# INLINE linesUnlinesArrayCharCopy #-}
474−linesUnlinesArrayCharCopy :: Handle -> Handle -> IO ()
475−linesUnlinesArrayCharCopy inh outh =
476− S.fold (FH.write outh)
477− $ SS.encodeLatin1
478− $ IUA.unlines
479− $ IUA.lines
480− $ SS.decodeLatin1
481− $ S.unfold FH.read inh
482−
483−#ifdef INSPECTION
484−inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Storable]
485−-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step
486−-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''AT.FlattenState
487−-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''D.ConcatMapUState
488−#endif
489−
490−-- XXX to write this we need to be able to map decodeUtf8 on the A.read fold.
491−-- For that we have to write decodeUtf8 as a Pipe.
492−{-
493−{-# INLINE linesUnlinesArrayUtf8Copy #-}
494−linesUnlinesArrayUtf8Copy :: Handle -> Handle -> IO ()
495−linesUnlinesArrayUtf8Copy inh outh =
496− S.fold (FH.write outh)
497− $ SS.encodeLatin1
498− $ IP.intercalate (A.fromList [10]) (pipe SS.decodeUtf8P A.read)
499− $ S.splitOnSuffix (== '\n') (IFL.lmap SS.encodeUtf8 A.write)
500− $ SS.decodeLatin1
501− $ S.unfold FH.read inh
502−-}
503−
504−foreign import ccall unsafe "u_iswspace"
505− iswspace :: Int -> Int
506−
507−-- Code copied from base/Data.Char to INLINE it
508−{-# INLINE isSpace #-}
509−isSpace :: Char -> Bool
510−-- isSpace includes non-breaking space
511−-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints
512−-- at or below 0x377 have been assigned, so we shouldn't have to worry about
513−-- any new spaces appearing below there. It would probably be best to
514−-- use branchless ||, but currently the eqLit transformation will undo that,
515−-- so we'll do it like this until there's a way around that.
516−isSpace c
517− | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
518− | otherwise = iswspace (ord c) /= 0
519− where
520− uc = fromIntegral (ord c) :: Word
521−
522−{-# INLINE isSp #-}
523−isSp :: Word8 -> Bool
524−isSp = isSpace . chr . fromIntegral
525−
526−-- | Word, unwords and copy
527−{-# INLINE wordsUnwordsCopyWord8 #-}
528−wordsUnwordsCopyWord8 :: Handle -> Handle -> IO ()
529−wordsUnwordsCopyWord8 inh outh =
530− S.fold (FH.write outh)
531− $ IP.interposeSuffix 32 IUF.fromList
532− $ S.wordsBy isSp FL.toList
533− $ S.unfold FH.read inh
534−
535−#ifdef INSPECTION
536−inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8
537−-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''Step
538−-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''D.ConcatMapUState
539−#endif
540−
541−-- | Word, unwords and copy
542−{-# INLINE wordsUnwordsCopy #-}
543−wordsUnwordsCopy :: Handle -> Handle -> IO ()
544−wordsUnwordsCopy inh outh =
545− S.fold (FH.write outh)
546− $ SS.encodeLatin1
547− $ IUS.unwords IUF.fromList
548− -- XXX This pipeline does not fuse with wordsBy but fuses with splitOn
549− -- with -funfolding-use-threshold=300. With wordsBy it does not fuse
550− -- even with high limits for inlining and spec-constr ghc options. With
551− -- -funfolding-use-threshold=400 it performs pretty well and there
552− -- is no evidence in the core that a join point involving Step
553− -- constructors is not getting inlined. Not being able to fuse at all in
554− -- this case could be an unknown issue, need more investigation.
555− $ S.wordsBy isSpace FL.toList
556− -- -- $ S.splitOn isSpace FL.toList
557− $ SS.decodeLatin1
558− $ S.unfold FH.read inh
559−
560−#ifdef INSPECTION
561−-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy
562−-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step
563−-- inspect $ 'wordsUnwordsCopy `hasNoType` ''AT.FlattenState
564−-- inspect $ 'wordsUnwordsCopy `hasNoType` ''D.ConcatMapUState
565−#endif
566−
567−{-# INLINE wordsUnwordsCharArrayCopy #-}
568−wordsUnwordsCharArrayCopy :: Handle -> Handle -> IO ()
569−wordsUnwordsCharArrayCopy inh outh =
570− S.fold (FH.write outh)
571− $ SS.encodeLatin1
572− $ IUA.unwords
573− $ IUA.words
574− $ SS.decodeLatin1
575− $ S.unfold FH.read inh
576−
577−lf :: Word8
578−lf = fromIntegral (ord '\n')
579−
580−toarr :: String -> A.Array Word8
581−toarr = A.fromList . map (fromIntegral . ord)
582−
583−-- | Split on line feed.
584−{-# INLINE splitOn #-}
585−splitOn :: Handle -> IO Int
586−splitOn inh =
587− (S.length $ S.splitOn (== lf) FL.drain
588− $ S.unfold FH.read inh) -- >>= print
589−
590−#ifdef INSPECTION
591−inspect $ hasNoTypeClasses 'splitOn
592−inspect $ 'splitOn `hasNoType` ''Step
593−inspect $ 'splitOn `hasNoType` ''AT.FlattenState
594−inspect $ 'splitOn `hasNoType` ''D.ConcatMapUState
595−#endif
596−
597−-- | Split suffix on line feed.
598−{-# INLINE splitOnSuffix #-}
599−splitOnSuffix :: Handle -> IO Int
600−splitOnSuffix inh =
601− (S.length $ S.splitOnSuffix (== lf) FL.drain
602− $ S.unfold FH.read inh) -- >>= print
603−
604−#ifdef INSPECTION
605−inspect $ hasNoTypeClasses 'splitOnSuffix
606−inspect $ 'splitOnSuffix `hasNoType` ''Step
607−inspect $ 'splitOnSuffix `hasNoType` ''AT.FlattenState
608−inspect $ 'splitOnSuffix `hasNoType` ''D.ConcatMapUState
609−#endif
610−
611−-- | Split on line feed.
612−{-# INLINE parseManySepBy #-}
613−parseManySepBy :: Handle -> IO Int
614−parseManySepBy inh =
615− (S.length $ IP.parseMany (PR.sliceSepBy (== lf) FL.drain)
616− (S.unfold FH.read inh)) -- >>= print
617−
618−-- | Words by space
619−{-# INLINE wordsBy #-}
620−wordsBy :: Handle -> IO Int
621−wordsBy inh =
622− (S.length $ S.wordsBy isSp FL.drain
623− $ S.unfold FH.read inh) -- >>= print
624−
625−#ifdef INSPECTION
626−inspect $ hasNoTypeClasses 'wordsBy
627−inspect $ 'wordsBy `hasNoType` ''Step
628−inspect $ 'wordsBy `hasNoType` ''AT.FlattenState
629−inspect $ 'wordsBy `hasNoType` ''D.ConcatMapUState
630−#endif
631−
632−-- | Split on a word8 sequence.
633−{-# INLINE splitOnSeq #-}
634−splitOnSeq :: String -> Handle -> IO Int
635−splitOnSeq str inh =
636− (S.length $ IP.splitOnSeq (toarr str) FL.drain
637− $ S.unfold FH.read inh) -- >>= print
638−
639−#ifdef INSPECTION
640−-- inspect $ hasNoTypeClasses 'splitOnSeq
641−-- inspect $ 'splitOnSeq `hasNoType` ''Step
642−-- inspect $ 'splitOnSeq `hasNoType` ''AT.FlattenState
643−-- inspect $ 'splitOnSeq `hasNoType` ''D.ConcatMapUState
644−#endif
645−
646−-- | Split on a character sequence.
647−{-# INLINE splitOnSeqUtf8 #-}
648−splitOnSeqUtf8 :: String -> Handle -> IO Int
649−splitOnSeqUtf8 str inh =
650− (S.length $ IP.splitOnSeq (A.fromList str) FL.drain
651− $ IUS.decodeUtf8ArraysLenient
652− $ IFH.toChunks inh) -- >>= print
653−
654−-- | Split on suffix sequence.
655−{-# INLINE splitOnSuffixSeq #-}
656−splitOnSuffixSeq :: String -> Handle -> IO Int
657−splitOnSuffixSeq str inh =
658− (S.length $ IP.splitOnSuffixSeq (toarr str) FL.drain
659− $ S.unfold FH.read inh) -- >>= print
660−
661−#ifdef INSPECTION
662−-- inspect $ hasNoTypeClasses 'splitOnSuffixSeq
663−-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step
664−-- inspect $ 'splitOnSuffixSeq `hasNoType` ''AT.FlattenState
665−-- inspect $ 'splitOnSuffixSeq `hasNoType` ''D.ConcatMapUState
666−#endif
benchmark/Streamly/Benchmark/FileSystem/Handle.hsnew file+1351
@@ -0,0 +1,1351 @@
1+-- |
2+-- Module : Streamly.Benchmark.FileSystem.Handle
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.DeepSeq (NFData)
23+import Control.Exception (SomeException)
24+import Data.Char (ord, chr)
25+import Data.Functor.Identity (runIdentity)
26+import Data.Word (Word8)
27+import System.Directory (getFileSize)
28+import System.Environment (lookupEnv)
29+import System.IO (openFile, IOMode(..), Handle, hClose)
30+import System.Process.Typed (shell, runProcess_)
31+import Prelude hiding (last, length)
32+
33+import qualified Streamly.Data.Fold as FL
34+import qualified Streamly.Data.Unicode.Stream as SS
35+import qualified Streamly.FileSystem.Handle as FH
36+-- import qualified Streamly.Internal.Data.Fold as IFL
37+import qualified Streamly.Internal.Data.Parser as PR
38+import qualified Streamly.Internal.Data.Stream.StreamD as D
39+import qualified Streamly.Internal.Data.Unfold as IUF
40+import qualified Streamly.Internal.Data.Unicode.Stream as IUS
41+import qualified Streamly.Internal.FileSystem.Handle as IFH
42+import qualified Streamly.Internal.Memory.Array as IA
43+import qualified Streamly.Internal.Memory.Array.Types as AT
44+import qualified Streamly.Internal.Memory.ArrayStream as AS
45+import qualified Streamly.Internal.Memory.Unicode.Array as IUA
46+import qualified Streamly.Internal.Prelude as IP
47+import qualified Streamly.Memory.Array as A
48+import qualified Streamly.Prelude as S
49+
50+import Data.IORef
51+import Gauge hiding (env)
52+import Streamly.Benchmark.Common
53+
54+#ifdef INSPECTION
55+import Foreign.Storable (Storable)
56+import Streamly.Internal.Data.Stream.StreamD.Type (Step(..), GroupState)
57+import Test.Inspection
58+#endif
59+
60+-------------------------------------------------------------------------------
61+--
62+-------------------------------------------------------------------------------
63+
64+moduleName :: String
65+moduleName = "FileSystem.Handle"
66+
67+-------------------------------------------------------------------------------
68+--
69+-------------------------------------------------------------------------------
70+
71+scratchDir :: String
72+scratchDir = "benchmark-tmp"
73+
74+outfile :: String
75+outfile = scratchDir ++ "out.txt"
76+
77+smallFileSize :: Int
78+smallFileSize = 10 * 1024 * 1024
79+
80+inFileSmall :: String
81+inFileSmall = scratchDir ++ "in-10MB.txt"
82+
83+bigFileSize :: Int
84+bigFileSize = 100 * 1024 * 1024
85+
86+inFileBig :: String
87+inFileBig = scratchDir ++ "in-100MB.txt"
88+
89+blockSize :: Int
90+blockSize = 32768
91+
92+blockCount :: Int -> Int
93+blockCount size = (size + blockSize - 1) `div` blockSize
94+
95+data Handles = Handles Handle Handle
96+
97+mkBench :: NFData b => String -> IORef Handles -> IO b -> Benchmark
98+mkBench name href action =
99+ bench name $ perRunEnv (do
100+ Handles inH outH <- readIORef href
101+
102+ -- close old handles
103+ hClose inH
104+ hClose outH
105+
106+ -- reopen
107+ inh <- openFile inFileBig ReadMode
108+ outh <- openFile outfile WriteMode
109+
110+ -- update
111+ writeIORef href $ Handles inh outh
112+ )
113+ (\_ -> action)
114+
115+-------------------------------------------------------------------------------
116+-- read chunked using toChunks
117+-------------------------------------------------------------------------------
118+
119+-- | Get the last byte from a file bytestream.
120+{-# INLINE toChunksLast #-}
121+toChunksLast :: Handle -> IO (Maybe Word8)
122+toChunksLast inh = do
123+ let s = IFH.toChunks inh
124+ larr <- S.last s
125+ return $ case larr of
126+ Nothing -> Nothing
127+ Just arr -> IA.readIndex arr (A.length arr - 1)
128+
129+#ifdef INSPECTION
130+inspect $ hasNoTypeClasses 'toChunksLast
131+inspect $ 'toChunksLast `hasNoType` ''Step
132+#endif
133+
134+-- | Count the number of bytes in a file.
135+{-# INLINE toChunksSumLengths #-}
136+toChunksSumLengths :: Handle -> IO Int
137+toChunksSumLengths inh =
138+ let s = IFH.toChunks inh
139+ in S.sum (S.map A.length s)
140+
141+#ifdef INSPECTION
142+inspect $ hasNoTypeClasses 'toChunksSumLengths
143+inspect $ 'toChunksSumLengths `hasNoType` ''Step
144+#endif
145+
146+-- | Count the number of lines in a file.
147+{-# INLINE toChunksSplitOnSuffix #-}
148+toChunksSplitOnSuffix :: Handle -> IO Int
149+toChunksSplitOnSuffix = S.length . AS.splitOnSuffix 10 . IFH.toChunks
150+
151+#ifdef INSPECTION
152+inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix
153+inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step
154+#endif
155+
156+-- XXX use a word splitting combinator instead of splitOn and test it.
157+-- | Count the number of words in a file.
158+{-# INLINE toChunksSplitOn #-}
159+toChunksSplitOn :: Handle -> IO Int
160+toChunksSplitOn = S.length . AS.splitOn 32 . IFH.toChunks
161+
162+#ifdef INSPECTION
163+inspect $ hasNoTypeClasses 'toChunksSplitOn
164+inspect $ 'toChunksSplitOn `hasNoType` ''Step
165+#endif
166+
167+-- | Sum the bytes in a file.
168+{-# INLINE toChunksCountBytes #-}
169+toChunksCountBytes :: Handle -> IO Word8
170+toChunksCountBytes inh = do
171+ let foldlArr' f z = runIdentity . S.foldl' f z . IA.toStream
172+ let s = IFH.toChunks inh
173+ S.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
174+
175+#ifdef INSPECTION
176+inspect $ hasNoTypeClasses 'toChunksCountBytes
177+inspect $ 'toChunksCountBytes `hasNoType` ''Step
178+#endif
179+
180+{-# INLINE toChunksWithBufferOfDecodeUtf8ArraysLenient #-}
181+toChunksWithBufferOfDecodeUtf8ArraysLenient :: Handle -> IO ()
182+toChunksWithBufferOfDecodeUtf8ArraysLenient inh =
183+ S.drain
184+ $ IUS.decodeUtf8ArraysLenient
185+ $ IFH.toChunksWithBufferOf (1024*1024) inh
186+
187+#ifdef INSPECTION
188+inspect $ hasNoTypeClasses 'decodeUtf8Lenient
189+-- inspect $ 'decodeUtf8Lenient `hasNoType` ''Step
190+-- inspect $ 'decodeUtf8Lenient `hasNoType` ''AT.FlattenState
191+-- inspect $ 'decodeUtf8Lenient `hasNoType` ''D.ConcatMapUState
192+#endif
193+
194+o_1_space_read_chunked :: IORef Handles -> Handle -> Int -> [Benchmark]
195+o_1_space_read_chunked href _ _ =
196+ -- read using toChunks instead of read
197+ [ bgroup "reduce/toChunks"
198+ [ mkBench "S.last (32K)" href $ do
199+ Handles inh _ <- readIORef href
200+ toChunksLast inh
201+ -- Note: this cannot be fairly compared with GNU wc -c or wc -m as
202+ -- wc uses lseek to just determine the file size rather than reading
203+ -- and counting characters.
204+ , mkBench "S.sum . S.map A.length (32K)" href $ do
205+ Handles inh _ <- readIORef href
206+ toChunksSumLengths inh
207+ , mkBench "AS.splitOnSuffix (32K)" href $ do
208+ Handles inh _ <- readIORef href
209+ toChunksSplitOnSuffix inh
210+ , mkBench "AS.splitOn (32K)" href $ do
211+ Handles inh _ <- readIORef href
212+ toChunksSplitOn inh
213+ , mkBench "countBytes (32K)" href $ do
214+ Handles inh _ <- readIORef href
215+ toChunksCountBytes inh
216+ , mkBench "US.decodeUtf8ArraysLenient (1MB)" href $ do
217+ Handles inh _ <- readIORef href
218+ toChunksWithBufferOfDecodeUtf8ArraysLenient inh
219+ ]
220+ ]
221+
222+-- TBD reading with unfold
223+
224+-------------------------------------------------------------------------------
225+-- copy chunked
226+-------------------------------------------------------------------------------
227+
228+-- | Send the file contents to /dev/null
229+{-# INLINE toChunksWithBufferOf #-}
230+toChunksWithBufferOf :: Handle -> Handle -> IO ()
231+toChunksWithBufferOf devNull inh =
232+ S.fold (IFH.writeChunks devNull) $ IFH.toChunksWithBufferOf (256*1024) inh
233+
234+#ifdef INSPECTION
235+inspect $ hasNoTypeClasses 'toChunksWithBufferOf
236+inspect $ 'toChunksWithBufferOf `hasNoType` ''Step
237+#endif
238+
239+-- | Copy file
240+{-# INLINE copyChunks #-}
241+copyChunks :: Handle -> Handle -> IO ()
242+copyChunks inh outh =
243+ let s = IFH.toChunks inh
244+ in S.fold (IFH.writeChunks outh) s
245+
246+#ifdef INSPECTION
247+inspect $ hasNoTypeClasses 'toChunksWriteChunks
248+inspect $ 'toChunksWriteChunks `hasNoType` ''Step
249+#endif
250+
251+-- | Copy file
252+{-# INLINE copyCodecUtf8ArraysLenient #-}
253+copyCodecUtf8ArraysLenient :: Handle -> Handle -> IO ()
254+copyCodecUtf8ArraysLenient inh outh =
255+ S.fold (FH.write outh)
256+ $ SS.encodeUtf8
257+ $ IUS.decodeUtf8ArraysLenient
258+ $ IFH.toChunksWithBufferOf (1024*1024) inh
259+
260+#ifdef INSPECTION
261+inspect $ hasNoTypeClasses 'copyCodecUtf8ArraysLenient
262+-- inspect $ 'copyCodecUtf8ArraysLenient `hasNoType` ''Step
263+-- inspect $ 'copyCodecUtf8ArraysLenient `hasNoType` ''AT.FlattenState
264+-- inspect $ 'copyCodecUtf8ArraysLenient `hasNoType` ''D.ConcatMapUState
265+#endif
266+
267+o_1_space_copy_chunked :: IORef Handles -> Handle -> Int -> [Benchmark]
268+o_1_space_copy_chunked href devNull _ =
269+ [ bgroup "copy/toChunks"
270+ [ mkBench "toNull (256K)" href $ do
271+ Handles inh _ <- readIORef href
272+ toChunksWithBufferOf devNull inh
273+ , mkBench "raw" href $ do
274+ Handles inh outh <- readIORef href
275+ copyChunks inh outh
276+ , mkBench "decodeEncodeUtf8Lenient" href $ do
277+ Handles inh outh <- readIORef href
278+ copyCodecUtf8ArraysLenient inh outh
279+ ]
280+ ]
281+
282+-- TBD reading with unfold
283+
284+-------------------------------------------------------------------------------
285+-- Exceptions readChunks
286+-------------------------------------------------------------------------------
287+
288+-- | Send the file contents to /dev/null with exception handling
289+{-# INLINE readChunksWithBufferOfOnExceptionUnfold #-}
290+readChunksWithBufferOfOnExceptionUnfold :: Handle -> Handle -> IO ()
291+readChunksWithBufferOfOnExceptionUnfold devNull inh =
292+ let readEx = IUF.onException (\_ -> hClose inh)
293+ (IUF.supplyFirst FH.readChunksWithBufferOf (256*1024))
294+ in IUF.fold readEx (IFH.writeChunks devNull) inh
295+
296+#ifdef INSPECTION
297+inspect $ hasNoTypeClasses 'readChunksWithBufferOfOnExceptionUnfold
298+-- inspect $ 'readChunksWithBufferOfOnExceptionUnfold `hasNoType` ''Step
299+#endif
300+
301+-- | Send the file contents to /dev/null with exception handling
302+{-# INLINE readChunksWithBufferOfBracketUnfold #-}
303+readChunksWithBufferOfBracketUnfold :: Handle -> Handle -> IO ()
304+readChunksWithBufferOfBracketUnfold devNull inh =
305+ let readEx = IUF.bracket return (\_ -> hClose inh)
306+ (IUF.supplyFirst FH.readChunksWithBufferOf (256*1024))
307+ in IUF.fold readEx (IFH.writeChunks devNull) inh
308+
309+#ifdef INSPECTION
310+inspect $ hasNoTypeClasses 'readChunksWithBufferOfBracketUnfold
311+-- inspect $ 'readChunksWithBufferOfBracketUnfold `hasNoType` ''Step
312+#endif
313+
314+{-# INLINE readChunksWithBufferOfBracketIOUnfold #-}
315+readChunksWithBufferOfBracketIOUnfold :: Handle -> Handle -> IO ()
316+readChunksWithBufferOfBracketIOUnfold devNull inh =
317+ let readEx = IUF.bracketIO return (\_ -> hClose inh)
318+ (IUF.supplyFirst FH.readChunksWithBufferOf (256*1024))
319+ in IUF.fold readEx (IFH.writeChunks devNull) inh
320+
321+o_1_space_copy_exceptions_readChunks :: IORef Handles -> Handle -> Int -> [Benchmark]
322+o_1_space_copy_exceptions_readChunks href devNull _ =
323+ [ bgroup "copy/exceptions/unfold/readChunks"
324+ [ mkBench "onException (256K)" href $ do
325+ Handles inh _ <- readIORef href
326+ readChunksWithBufferOfOnExceptionUnfold devNull inh
327+ , mkBench "bracket (256K)" href $ do
328+ Handles inh _ <- readIORef href
329+ readChunksWithBufferOfBracketUnfold devNull inh
330+ , mkBench "bracketIO (256K)" href $ do
331+ Handles inh _ <- readIORef href
332+ readChunksWithBufferOfBracketIOUnfold devNull inh
333+ ]
334+ ]
335+
336+-------------------------------------------------------------------------------
337+-- Exceptions toChunks
338+-------------------------------------------------------------------------------
339+
340+-- | Send the file contents to /dev/null with exception handling
341+{-# INLINE toChunksWithBufferOfBracketStream #-}
342+toChunksWithBufferOfBracketStream :: Handle -> Handle -> IO ()
343+toChunksWithBufferOfBracketStream devNull inh =
344+ let readEx = S.bracket (return ()) (\_ -> hClose inh)
345+ (\_ -> IFH.toChunksWithBufferOf (256*1024) inh)
346+ in S.fold (IFH.writeChunks devNull) $ readEx
347+
348+#ifdef INSPECTION
349+inspect $ hasNoTypeClasses 'toChunksWithBufferOfBracketStream
350+-- inspect $ 'toChunksWithBufferOfBracketStream `hasNoType` ''Step
351+#endif
352+
353+{-# INLINE toChunksWithBufferOfBracketIOStream #-}
354+toChunksWithBufferOfBracketIOStream :: Handle -> Handle -> IO ()
355+toChunksWithBufferOfBracketIOStream devNull inh =
356+ let readEx = IP.bracketIO (return ()) (\_ -> hClose inh)
357+ (\_ -> IFH.toChunksWithBufferOf (256*1024) inh)
358+ in S.fold (IFH.writeChunks devNull) $ readEx
359+
360+o_1_space_copy_exceptions_toChunks :: IORef Handles -> Handle -> Int -> [Benchmark]
361+o_1_space_copy_exceptions_toChunks href devNull _ =
362+ [ bgroup "copy/exceptions/stream/toChunks"
363+ [ mkBench "bracket (256K)" href $ do
364+ Handles inh _ <- readIORef href
365+ toChunksWithBufferOfBracketStream devNull inh
366+ , mkBench "bracketIO (256K)" href $ do
367+ Handles inh _ <- readIORef href
368+ toChunksWithBufferOfBracketIOStream devNull inh
369+ ]
370+ ]
371+
372+-------------------------------------------------------------------------------
373+-- unfold read
374+-------------------------------------------------------------------------------
375+
376+-- | Get the last byte from a file bytestream.
377+{-# INLINE readLast #-}
378+readLast :: Handle -> IO (Maybe Word8)
379+readLast = S.last . S.unfold FH.read
380+
381+#ifdef INSPECTION
382+inspect $ hasNoTypeClasses 'readLast
383+inspect $ 'readLast `hasNoType` ''Step
384+inspect $ 'readLast `hasNoType` ''AT.FlattenState
385+inspect $ 'readLast `hasNoType` ''D.ConcatMapUState
386+#endif
387+
388+-- assert that flattenArrays constructors are not present
389+-- | Count the number of bytes in a file.
390+{-# INLINE readCountBytes #-}
391+readCountBytes :: Handle -> IO Int
392+readCountBytes = S.length . S.unfold FH.read
393+
394+#ifdef INSPECTION
395+inspect $ hasNoTypeClasses 'countBytes
396+inspect $ 'countBytes `hasNoType` ''Step
397+inspect $ 'countBytes `hasNoType` ''AT.FlattenState
398+inspect $ 'countBytes `hasNoType` ''D.ConcatMapUState
399+#endif
400+
401+-- | Count the number of lines in a file.
402+{-# INLINE readCountLines #-}
403+readCountLines :: Handle -> IO Int
404+readCountLines =
405+ S.length
406+ . IUS.lines FL.drain
407+ . SS.decodeLatin1
408+ . S.unfold FH.read
409+
410+#ifdef INSPECTION
411+inspect $ hasNoTypeClasses 'readCountLines
412+inspect $ 'readCountLines `hasNoType` ''Step
413+inspect $ 'readCountLines `hasNoType` ''AT.FlattenState
414+inspect $ 'readCountLines `hasNoType` ''D.ConcatMapUState
415+#endif
416+
417+-- | Count the number of words in a file.
418+{-# INLINE readCountWords #-}
419+readCountWords :: Handle -> IO Int
420+readCountWords =
421+ S.length
422+ . IUS.words FL.drain
423+ . SS.decodeLatin1
424+ . S.unfold FH.read
425+
426+#ifdef INSPECTION
427+inspect $ hasNoTypeClasses 'readCountWords
428+-- inspect $ 'readCountWords `hasNoType` ''Step
429+-- inspect $ 'readCountWords `hasNoType` ''D.ConcatMapUState
430+#endif
431+
432+-- | Sum the bytes in a file.
433+{-# INLINE readSumBytes #-}
434+readSumBytes :: Handle -> IO Word8
435+readSumBytes = S.sum . S.unfold FH.read
436+
437+#ifdef INSPECTION
438+inspect $ hasNoTypeClasses 'readSumBytes
439+inspect $ 'readSumBytes `hasNoType` ''Step
440+inspect $ 'readSumBytes `hasNoType` ''AT.FlattenState
441+inspect $ 'readSumBytes `hasNoType` ''D.ConcatMapUState
442+#endif
443+
444+{-# INLINE readDrain #-}
445+readDrain :: Handle -> IO ()
446+readDrain inh = S.drain $ S.unfold FH.read inh
447+
448+{-# INLINE readDecodeLatin1 #-}
449+readDecodeLatin1 :: Handle -> IO ()
450+readDecodeLatin1 inh =
451+ S.drain
452+ $ SS.decodeLatin1
453+ $ S.unfold FH.read inh
454+
455+{-# INLINE readDecodeUtf8Lax #-}
456+readDecodeUtf8Lax :: Handle -> IO ()
457+readDecodeUtf8Lax inh =
458+ S.drain
459+ $ SS.decodeUtf8Lax
460+ $ S.unfold FH.read inh
461+
462+#ifdef INSPECTION
463+inspect $ hasNoTypeClasses 'readDecodeUtf8Lax
464+-- inspect $ 'readDecodeUtf8Lax `hasNoType` ''Step
465+-- inspect $ 'readDecodeUtf8Lax `hasNoType` ''AT.FlattenState
466+-- inspect $ 'readDecodeUtf8Lax `hasNoType` ''D.ConcatMapUState
467+#endif
468+
469+o_1_space_reduce_read :: IORef Handles -> Handle -> Int -> [Benchmark]
470+o_1_space_reduce_read href _ _ =
471+ [ bgroup "reduce/read"
472+ [ -- read raw bytes without any decoding
473+ mkBench "S.drain" href $ do
474+ Handles inh _ <- readIORef href
475+ readDrain inh
476+ , mkBench "S.last" href $ do
477+ Handles inh _ <- readIORef href
478+ readLast inh
479+ , mkBench "S.sum" href $ do
480+ Handles inh _ <- readIORef href
481+ readSumBytes inh
482+
483+ -- read with Latin1 decoding
484+ , mkBench "SS.decodeLatin1" href $ do
485+ Handles inh _ <- readIORef href
486+ readDecodeLatin1 inh
487+ , mkBench "S.length" href $ do
488+ Handles inh _ <- readIORef href
489+ readCountBytes inh
490+ , mkBench "US.lines . SS.decodeLatin1" href $ do
491+ Handles inh _ <- readIORef href
492+ readCountLines inh
493+ , mkBench "US.words . SS.decodeLatin1" href $ do
494+ Handles inh _ <- readIORef href
495+ readCountWords inh
496+
497+ -- read with utf8 decoding
498+ , mkBench "SS.decodeUtf8Lax" href $ do
499+ Handles inh _ <- readIORef href
500+ readDecodeUtf8Lax inh
501+ ]
502+ ]
503+
504+-------------------------------------------------------------------------------
505+-- stream toBytes
506+-------------------------------------------------------------------------------
507+
508+-- | Count the number of lines in a file.
509+{-# INLINE toChunksConcatUnfoldCountLines #-}
510+toChunksConcatUnfoldCountLines :: Handle -> IO Int
511+toChunksConcatUnfoldCountLines inh =
512+ S.length
513+ $ IUS.lines FL.drain
514+ $ SS.decodeLatin1
515+ -- XXX replace with toBytes
516+ $ S.concatUnfold A.read (IFH.toChunks inh)
517+
518+#ifdef INSPECTION
519+inspect $ hasNoTypeClasses 'countLinesU
520+inspect $ 'countLinesU `hasNoType` ''Step
521+inspect $ 'countLinesU `hasNoType` ''D.ConcatMapUState
522+#endif
523+
524+o_1_space_reduce_toBytes :: IORef Handles -> Handle -> Int -> [Benchmark]
525+o_1_space_reduce_toBytes href _ _ =
526+ [ bgroup "reduce/toBytes"
527+ [ mkBench "US.lines . SS.decodeLatin1" href $ do
528+ Handles inh _ <- readIORef href
529+ toChunksConcatUnfoldCountLines inh
530+ ]
531+ ]
532+
533+-------------------------------------------------------------------------------
534+-- reduce after grouping in chunks
535+-------------------------------------------------------------------------------
536+
537+{-# INLINE chunksOfSum #-}
538+chunksOfSum :: Int -> Handle -> IO Int
539+chunksOfSum n inh = S.length $ S.chunksOf n FL.sum (S.unfold FH.read inh)
540+
541+{-# INLINE parseManyChunksOfSum #-}
542+parseManyChunksOfSum :: Int -> Handle -> IO Int
543+parseManyChunksOfSum n inh =
544+ S.length $ IP.parseMany (PR.take n FL.sum) (S.unfold FH.read inh)
545+
546+-- | Slice in chunks of size n and get the count of chunks.
547+{-# INLINE chunksOf #-}
548+chunksOf :: Int -> Handle -> IO Int
549+chunksOf n inh =
550+ -- writeNUnsafe gives 2.5x boost here over writeN.
551+ -- XXX replace with S.arraysOf
552+ S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.read inh)
553+
554+#ifdef INSPECTION
555+inspect $ hasNoTypeClasses 'chunksOf
556+inspect $ 'chunksOf `hasNoType` ''Step
557+inspect $ 'chunksOf `hasNoType` ''AT.FlattenState
558+inspect $ 'chunksOf `hasNoType` ''D.ConcatMapUState
559+inspect $ 'chunksOf `hasNoType` ''GroupState
560+#endif
561+
562+-- This is to make sure that the concatMap in FH.read, groupsOf and foldlM'
563+-- together can fuse.
564+--
565+-- | Slice in chunks of size n and get the count of chunks.
566+{-# INLINE _chunksOfD #-}
567+_chunksOfD :: Int -> Handle -> IO Int
568+_chunksOfD n inh =
569+ D.foldlM' (\i _ -> return $ i + 1) (return 0)
570+ $ D.groupsOf n (AT.writeNUnsafe n)
571+ $ D.fromStreamK (S.unfold FH.read inh)
572+
573+#ifdef INSPECTION
574+inspect $ hasNoTypeClasses '_chunksOfD
575+inspect $ '_chunksOfD `hasNoType` ''Step
576+inspect $ '_chunksOfD `hasNoType` ''GroupState
577+inspect $ '_chunksOfD `hasNoType` ''AT.FlattenState
578+inspect $ '_chunksOfD `hasNoType` ''D.ConcatMapUState
579+#endif
580+
581+o_1_space_reduce_read_grouped :: IORef Handles -> Handle -> Int -> [Benchmark]
582+o_1_space_reduce_read_grouped href _ value =
583+ [ bgroup "reduce/read/chunks"
584+ [ mkBench ("S.chunksOf " ++ show value ++ " FL.sum") href $ do
585+ Handles inh _ <- readIORef href
586+ chunksOfSum value inh
587+ , mkBench "S.chunksOf 1 FL.sum" href $ do
588+ Handles inh _ <- readIORef href
589+ chunksOfSum 1 inh
590+
591+ -- Chunk using parsers
592+ , mkBench ("S.parseMany (PR.take " ++ show value ++ " FL.sum)")
593+ href $ do
594+ Handles inh _ <- readIORef href
595+ parseManyChunksOfSum value inh
596+ , mkBench "S.parseMany (PR.take 1 FL.sum)" href $ do
597+ Handles inh _ <- readIORef href
598+ parseManyChunksOfSum 1 inh
599+
600+ -- folding chunks to arrays
601+ , mkBench "S.arraysOf 1" href $ do
602+ Handles inh _ <- readIORef href
603+ chunksOf 1 inh
604+ , mkBench "S.arraysOf 10" href $ do
605+ Handles inh _ <- readIORef href
606+ chunksOf 10 inh
607+ , mkBench "S.arraysOf 1000" href $ do
608+ Handles inh _ <- readIORef href
609+ chunksOf 1000 inh
610+ ]
611+ ]
612+
613+-------------------------------------------------------------------------------
614+-- copy unfold
615+-------------------------------------------------------------------------------
616+
617+-- | Send the file contents to /dev/null
618+{-# INLINE readWriteNull #-}
619+readWriteNull :: Handle -> Handle -> IO ()
620+readWriteNull devNull inh = S.fold (FH.write devNull) $ S.unfold FH.read inh
621+
622+#ifdef INSPECTION
623+inspect $ hasNoTypeClasses 'readWriteNull
624+inspect $ 'readWriteNull `hasNoType` ''Step
625+inspect $ 'readWriteNull `hasNoType` ''AT.FlattenState
626+inspect $ 'readWriteNull `hasNoType` ''D.ConcatMapUState
627+#endif
628+
629+-- | Copy file
630+{-# INLINE copyStream #-}
631+copyStream :: Handle -> Handle -> IO ()
632+copyStream inh outh = S.fold (FH.write outh) (S.unfold FH.read inh)
633+
634+#ifdef INSPECTION
635+inspect $ hasNoTypeClasses 'copyStream
636+inspect $ 'copyStream `hasNoType` ''Step
637+inspect $ 'copyStream `hasNoType` ''AT.FlattenState
638+inspect $ 'copyStream `hasNoType` ''D.ConcatMapUState
639+#endif
640+
641+-- | Copy file
642+{-# INLINE copyStreamLatin1 #-}
643+copyStreamLatin1 :: Handle -> Handle -> IO ()
644+copyStreamLatin1 inh outh =
645+ S.fold (FH.write outh)
646+ $ SS.encodeLatin1
647+ $ SS.decodeLatin1
648+ $ S.unfold FH.read inh
649+
650+#ifdef INSPECTION
651+inspect $ hasNoTypeClasses 'copyStreamLatin1
652+inspect $ 'copyStreamLatin1 `hasNoType` ''Step
653+inspect $ 'copyStreamLatin1 `hasNoType` ''AT.FlattenState
654+inspect $ 'copyStreamLatin1 `hasNoType` ''D.ConcatMapUState
655+#endif
656+
657+-- | Copy file
658+{-# INLINE _copyStreamUtf8 #-}
659+_copyStreamUtf8 :: Handle -> Handle -> IO ()
660+_copyStreamUtf8 inh outh =
661+ S.fold (FH.write outh)
662+ $ SS.encodeUtf8
663+ $ SS.decodeUtf8
664+ $ S.unfold FH.read inh
665+
666+#ifdef INSPECTION
667+inspect $ hasNoTypeClasses '_copyStreamUtf8
668+-- inspect $ '_copyStreamUtf8 `hasNoType` ''Step
669+-- inspect $ '_copyStreamUtf8 `hasNoType` ''AT.FlattenState
670+-- inspect $ '_copyStreamUtf8 `hasNoType` ''D.ConcatMapUState
671+#endif
672+
673+-- | Copy file
674+{-# INLINE copyStreamUtf8Lax #-}
675+copyStreamUtf8Lax :: Handle -> Handle -> IO ()
676+copyStreamUtf8Lax inh outh =
677+ S.fold (FH.write outh)
678+ $ SS.encodeUtf8
679+ $ SS.decodeUtf8Lax
680+ $ S.unfold FH.read inh
681+
682+#ifdef INSPECTION
683+inspect $ hasNoTypeClasses 'copyStreamUtf8Lax
684+-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''Step
685+-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''AT.FlattenState
686+-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''D.ConcatMapUState
687+#endif
688+
689+o_1_space_copy_read :: IORef Handles -> Handle -> Int -> [Benchmark]
690+o_1_space_copy_read href devNull _ =
691+ [ bgroup "copy/read"
692+ [ mkBench "rawToNull" href $ do
693+ Handles inh _ <- readIORef href
694+ readWriteNull devNull inh
695+ , mkBench "rawToFile" href $ do
696+ Handles inh outh <- readIORef href
697+ copyStream inh outh
698+ -- This needs an ascii file, as decode just errors out.
699+ , mkBench "SS.encodeLatin1 . SS.decodeLatin1" href $ do
700+ Handles inh outh <- readIORef href
701+ copyStreamLatin1 inh outh
702+#ifdef DEVBUILD
703+ , mkBench "copyUtf8" href $ do
704+ Handles inh outh <- readIORef href
705+ _copyStreamUtf8 inh outh
706+#endif
707+ , mkBench "SS.encodeUtf8 . SS.decodeUtf8Lax" href $ do
708+ Handles inh outh <- readIORef href
709+ copyStreamUtf8Lax inh outh
710+ ]
711+ ]
712+
713+-------------------------------------------------------------------------------
714+-- copy stream
715+-------------------------------------------------------------------------------
716+
717+-- | Send the file contents to /dev/null
718+{-# INLINE readFromBytesNull #-}
719+readFromBytesNull :: Handle -> Handle -> IO ()
720+readFromBytesNull devNull inh = IFH.fromBytes devNull $ S.unfold FH.read inh
721+
722+#ifdef INSPECTION
723+inspect $ hasNoTypeClasses 'catStreamWrite
724+inspect $ 'catStreamWrite `hasNoType` ''Step
725+inspect $ 'catStreamWrite `hasNoType` ''AT.FlattenState
726+inspect $ 'catStreamWrite `hasNoType` ''D.ConcatMapUState
727+#endif
728+
729+o_1_space_copy_fromBytes :: IORef Handles -> Handle -> Int -> [Benchmark]
730+o_1_space_copy_fromBytes href devNull _ =
731+ [ bgroup "copy/fromBytes"
732+ [ mkBench "rawToNull" href $ do
733+ Handles inh _ <- readIORef href
734+ readFromBytesNull devNull inh
735+ ]
736+ ]
737+
738+-------------------------------------------------------------------------------
739+-- unfold exceptions
740+-------------------------------------------------------------------------------
741+
742+-- | Send the file contents to /dev/null with exception handling
743+{-# INLINE readWriteOnExceptionUnfold #-}
744+readWriteOnExceptionUnfold :: Handle -> Handle -> IO ()
745+readWriteOnExceptionUnfold devNull inh =
746+ let readEx = IUF.onException (\_ -> hClose inh) FH.read
747+ in S.fold (FH.write devNull) $ S.unfold readEx inh
748+
749+#ifdef INSPECTION
750+inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold
751+-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''Step
752+-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''AT.FlattenState
753+-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''D.ConcatMapUState
754+#endif
755+
756+-- | Send the file contents to /dev/null with exception handling
757+{-# INLINE readWriteHandleExceptionUnfold #-}
758+readWriteHandleExceptionUnfold :: Handle -> Handle -> IO ()
759+readWriteHandleExceptionUnfold devNull inh =
760+ let handler (_e :: SomeException) = hClose inh >> return 10
761+ readEx = IUF.handle (IUF.singletonM handler) FH.read
762+ in S.fold (FH.write devNull) $ S.unfold readEx inh
763+
764+#ifdef INSPECTION
765+inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold
766+-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''Step
767+-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''AT.FlattenState
768+-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''D.ConcatMapUState
769+#endif
770+
771+-- | Send the file contents to /dev/null with exception handling
772+{-# INLINE readWriteFinallyUnfold #-}
773+readWriteFinallyUnfold :: Handle -> Handle -> IO ()
774+readWriteFinallyUnfold devNull inh =
775+ let readEx = IUF.finally (\_ -> hClose inh) FH.read
776+ in S.fold (FH.write devNull) $ S.unfold readEx inh
777+
778+#ifdef INSPECTION
779+inspect $ hasNoTypeClasses 'readWriteFinallyUnfold
780+-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''Step
781+-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''AT.FlattenState
782+-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''D.ConcatMapUState
783+#endif
784+
785+{-# INLINE readWriteFinallyIOUnfold #-}
786+readWriteFinallyIOUnfold :: Handle -> Handle -> IO ()
787+readWriteFinallyIOUnfold devNull inh =
788+ let readEx = IUF.finallyIO (\_ -> hClose inh) FH.read
789+ in S.fold (FH.write devNull) $ S.unfold readEx inh
790+
791+-- | Send the file contents to /dev/null with exception handling
792+{-# INLINE readWriteBracketUnfold #-}
793+readWriteBracketUnfold :: Handle -> Handle -> IO ()
794+readWriteBracketUnfold devNull inh =
795+ let readEx = IUF.bracket return (\_ -> hClose inh) FH.read
796+ in S.fold (FH.write devNull) $ S.unfold readEx inh
797+
798+#ifdef INSPECTION
799+inspect $ hasNoTypeClasses 'readWriteBracketUnfold
800+-- inspect $ 'readWriteBracketUnfold `hasNoType` ''Step
801+-- inspect $ 'readWriteBracketUnfold `hasNoType` ''AT.FlattenState
802+-- inspect $ 'readWriteBracketUnfold `hasNoType` ''D.ConcatMapUState
803+#endif
804+
805+{-# INLINE readWriteBracketIOUnfold #-}
806+readWriteBracketIOUnfold :: Handle -> Handle -> IO ()
807+readWriteBracketIOUnfold devNull inh =
808+ let readEx = IUF.bracketIO return (\_ -> hClose inh) FH.read
809+ in S.fold (FH.write devNull) $ S.unfold readEx inh
810+
811+o_1_space_copy_read_exceptions ::
812+ IORef Handles -> Handle -> Int -> [Benchmark]
813+o_1_space_copy_read_exceptions href devNull _ =
814+ [ bgroup "copy/read/exceptions"
815+ [ mkBench "UF.onException" href $ do
816+ Handles inh _ <- readIORef href
817+ readWriteOnExceptionUnfold devNull inh
818+ , mkBench "UF.handle" href $ do
819+ Handles inh _ <- readIORef href
820+ readWriteHandleExceptionUnfold devNull inh
821+ , mkBench "UF.finally" href $ do
822+ Handles inh _ <- readIORef href
823+ readWriteFinallyUnfold devNull inh
824+ , mkBench "UF.finallyIO" href $ do
825+ Handles inh _ <- readIORef href
826+ readWriteFinallyIOUnfold devNull inh
827+ , mkBench "UF.bracket" href $ do
828+ Handles inh _ <- readIORef href
829+ readWriteBracketUnfold devNull inh
830+ , mkBench "UF.bracketIO" href $ do
831+ Handles inh _ <- readIORef href
832+ readWriteBracketIOUnfold devNull inh
833+ ]
834+ ]
835+
836+-------------------------------------------------------------------------------
837+-- stream exceptions
838+-------------------------------------------------------------------------------
839+
840+-- | Send the file contents to /dev/null with exception handling
841+{-# INLINE readWriteOnExceptionStream #-}
842+readWriteOnExceptionStream :: Handle -> Handle -> IO ()
843+readWriteOnExceptionStream devNull inh =
844+ let readEx = S.onException (hClose inh) (S.unfold FH.read inh)
845+ in S.fold (FH.write devNull) $ readEx
846+
847+-- | Send the file contents to /dev/null with exception handling
848+{-# INLINE readWriteHandleExceptionStream #-}
849+readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
850+readWriteHandleExceptionStream devNull inh =
851+ let handler (_e :: SomeException) = S.yieldM (hClose inh >> return 10)
852+ readEx = S.handle handler (S.unfold FH.read inh)
853+ in S.fold (FH.write devNull) $ readEx
854+
855+-- | Send the file contents to /dev/null with exception handling
856+{-# INLINE readWriteFinallyStream #-}
857+readWriteFinallyStream :: Handle -> Handle -> IO ()
858+readWriteFinallyStream devNull inh =
859+ let readEx = S.finally (hClose inh) (S.unfold FH.read inh)
860+ in S.fold (FH.write devNull) readEx
861+
862+{-# INLINE readWriteFinallyIOStream #-}
863+readWriteFinallyIOStream :: Handle -> Handle -> IO ()
864+readWriteFinallyIOStream devNull inh =
865+ let readEx = IP.finallyIO (hClose inh) (S.unfold FH.read inh)
866+ in S.fold (FH.write devNull) readEx
867+
868+-- | Send the file contents to /dev/null with exception handling
869+{-# INLINE fromToBytesBracketStream #-}
870+fromToBytesBracketStream :: Handle -> Handle -> IO ()
871+fromToBytesBracketStream devNull inh =
872+ let readEx = S.bracket (return ()) (\_ -> hClose inh)
873+ (\_ -> IFH.toBytes inh)
874+ in IFH.fromBytes devNull $ readEx
875+
876+#ifdef INSPECTION
877+inspect $ hasNoTypeClasses 'readWriteBracketStream
878+-- inspect $ 'readWriteBracketStream `hasNoType` ''Step
879+#endif
880+
881+{-# INLINE fromToBytesBracketIOStream #-}
882+fromToBytesBracketIOStream :: Handle -> Handle -> IO ()
883+fromToBytesBracketIOStream devNull inh =
884+ let readEx = IP.bracketIO (return ()) (\_ -> hClose inh)
885+ (\_ -> IFH.toBytes inh)
886+ in IFH.fromBytes devNull $ readEx
887+
888+o_1_space_copy_stream_exceptions ::
889+ IORef Handles -> Handle -> Int -> [Benchmark]
890+o_1_space_copy_stream_exceptions href devNull _ =
891+ [ bgroup "copy/read/exceptions"
892+ [ mkBench "S.onException" href $ do
893+ Handles inh _ <- readIORef href
894+ readWriteOnExceptionStream devNull inh
895+ , mkBench "S.handle" href $ do
896+ Handles inh _ <- readIORef href
897+ readWriteHandleExceptionStream devNull inh
898+ , mkBench "S.finally" href $ do
899+ Handles inh _ <- readIORef href
900+ readWriteFinallyStream devNull inh
901+ , mkBench "S.finallyIO" href $ do
902+ Handles inh _ <- readIORef href
903+ readWriteFinallyIOStream devNull inh
904+ ]
905+ , bgroup "copy/fromToBytes/exceptions"
906+ [ mkBench "S.bracket" href $ do
907+ Handles inh _ <- readIORef href
908+ fromToBytesBracketStream devNull inh
909+ , mkBench "S.bracketIO" href $ do
910+ Handles inh _ <- readIORef href
911+ fromToBytesBracketIOStream devNull inh
912+ ]
913+ ]
914+
915+-------------------------------------------------------------------------------
916+-- copy with group/ungroup transformations
917+-------------------------------------------------------------------------------
918+
919+-- | Lines and unlines
920+{-# INLINE copyChunksSplitInterposeSuffix #-}
921+copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO ()
922+copyChunksSplitInterposeSuffix inh outh =
923+ S.fold (IFH.writeWithBufferOf (1024*1024) outh)
924+ $ AS.interposeSuffix 10
925+ $ AS.splitOnSuffix 10
926+ $ IFH.toChunksWithBufferOf (1024*1024) inh
927+
928+#ifdef INSPECTION
929+inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Storable]
930+-- inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
931+#endif
932+
933+-- | Words and unwords
934+{-# INLINE copyChunksSplitInterpose #-}
935+copyChunksSplitInterpose :: Handle -> Handle -> IO ()
936+copyChunksSplitInterpose inh outh =
937+ S.fold (IFH.writeWithBufferOf (1024*1024) outh)
938+ $ AS.interpose 32
939+ -- XXX this is not correct word splitting combinator
940+ $ AS.splitOn 32
941+ $ IFH.toChunksWithBufferOf (1024*1024) inh
942+
943+#ifdef INSPECTION
944+inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Storable]
945+-- inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step
946+#endif
947+
948+o_1_space_copy_toChunks_group_ungroup ::
949+ IORef Handles -> Handle -> Int -> [Benchmark]
950+o_1_space_copy_toChunks_group_ungroup href _ _ =
951+ [ bgroup "copy/toChunks/group-ungroup"
952+ [ mkBench "AS.interposeSuffix . AS.splitOnSuffix" href $ do
953+ Handles inh outh <- readIORef href
954+ copyChunksSplitInterposeSuffix inh outh
955+ , mkBench "AS.interpose . AS.splitOn" href $ do
956+ Handles inh outh <- readIORef href
957+ copyChunksSplitInterpose inh outh
958+ ]
959+ ]
960+
961+-------------------------------------------------------------------------------
962+-- copy with group/ungroup transformations
963+-------------------------------------------------------------------------------
964+
965+{-# INLINE linesUnlinesCopy #-}
966+linesUnlinesCopy :: Handle -> Handle -> IO ()
967+linesUnlinesCopy inh outh =
968+ S.fold (FH.write outh)
969+ $ SS.encodeLatin1
970+ $ IUS.unlines IUF.fromList
971+ $ S.splitOnSuffix (== '\n') FL.toList
972+ $ SS.decodeLatin1
973+ $ S.unfold FH.read inh
974+
975+{-# INLINE linesUnlinesArrayWord8Copy #-}
976+linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO ()
977+linesUnlinesArrayWord8Copy inh outh =
978+ S.fold (FH.write outh)
979+ $ IP.interposeSuffix 10 A.read
980+ $ S.splitOnSuffix (== 10) A.write
981+ $ S.unfold FH.read inh
982+
983+-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion
984+-- | Lines and unlines
985+{-# INLINE linesUnlinesArrayCharCopy #-}
986+linesUnlinesArrayCharCopy :: Handle -> Handle -> IO ()
987+linesUnlinesArrayCharCopy inh outh =
988+ S.fold (FH.write outh)
989+ $ SS.encodeLatin1
990+ $ IUA.unlines
991+ $ IUA.lines
992+ $ SS.decodeLatin1
993+ $ S.unfold FH.read inh
994+
995+#ifdef INSPECTION
996+inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Storable]
997+-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step
998+-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''AT.FlattenState
999+-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''D.ConcatMapUState
1000+#endif
1001+
1002+-- XXX to write this we need to be able to map decodeUtf8 on the A.read fold.
1003+-- For that we have to write decodeUtf8 as a Pipe.
1004+{-
1005+{-# INLINE linesUnlinesArrayUtf8Copy #-}
1006+linesUnlinesArrayUtf8Copy :: Handle -> Handle -> IO ()
1007+linesUnlinesArrayUtf8Copy inh outh =
1008+ S.fold (FH.write outh)
1009+ $ SS.encodeLatin1
1010+ $ IP.intercalate (A.fromList [10]) (pipe SS.decodeUtf8P A.read)
1011+ $ S.splitOnSuffix (== '\n') (IFL.lmap SS.encodeUtf8 A.write)
1012+ $ SS.decodeLatin1
1013+ $ S.unfold FH.read inh
1014+-}
1015+
1016+foreign import ccall unsafe "u_iswspace"
1017+ iswspace :: Int -> Int
1018+
1019+-- Code copied from base/Data.Char to INLINE it
1020+{-# INLINE isSpace #-}
1021+isSpace :: Char -> Bool
1022+-- isSpace includes non-breaking space
1023+-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints
1024+-- at or below 0x377 have been assigned, so we shouldn't have to worry about
1025+-- any new spaces appearing below there. It would probably be best to
1026+-- use branchless ||, but currently the eqLit transformation will undo that,
1027+-- so we'll do it like this until there's a way around that.
1028+isSpace c
1029+ | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
1030+ | otherwise = iswspace (ord c) /= 0
1031+ where
1032+ uc = fromIntegral (ord c) :: Word
1033+
1034+{-# INLINE isSp #-}
1035+isSp :: Word8 -> Bool
1036+isSp = isSpace . chr . fromIntegral
1037+
1038+-- | Word, unwords and copy
1039+{-# INLINE wordsUnwordsCopyWord8 #-}
1040+wordsUnwordsCopyWord8 :: Handle -> Handle -> IO ()
1041+wordsUnwordsCopyWord8 inh outh =
1042+ S.fold (FH.write outh)
1043+ $ IP.interposeSuffix 32 IUF.fromList
1044+ $ S.wordsBy isSp FL.toList
1045+ $ S.unfold FH.read inh
1046+
1047+#ifdef INSPECTION
1048+inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8
1049+-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''Step
1050+-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''D.ConcatMapUState
1051+#endif
1052+
1053+-- | Word, unwords and copy
1054+{-# INLINE wordsUnwordsCopy #-}
1055+wordsUnwordsCopy :: Handle -> Handle -> IO ()
1056+wordsUnwordsCopy inh outh =
1057+ S.fold (FH.write outh)
1058+ $ SS.encodeLatin1
1059+ $ IUS.unwords IUF.fromList
1060+ -- XXX This pipeline does not fuse with wordsBy but fuses with splitOn
1061+ -- with -funfolding-use-threshold=300. With wordsBy it does not fuse
1062+ -- even with high limits for inlining and spec-constr ghc options. With
1063+ -- -funfolding-use-threshold=400 it performs pretty well and there
1064+ -- is no evidence in the core that a join point involving Step
1065+ -- constructors is not getting inlined. Not being able to fuse at all in
1066+ -- this case could be an unknown issue, need more investigation.
1067+ $ S.wordsBy isSpace FL.toList
1068+ -- -- $ S.splitOn isSpace FL.toList
1069+ $ SS.decodeLatin1
1070+ $ S.unfold FH.read inh
1071+
1072+#ifdef INSPECTION
1073+-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy
1074+-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step
1075+-- inspect $ 'wordsUnwordsCopy `hasNoType` ''AT.FlattenState
1076+-- inspect $ 'wordsUnwordsCopy `hasNoType` ''D.ConcatMapUState
1077+#endif
1078+
1079+{-# INLINE wordsUnwordsCharArrayCopy #-}
1080+wordsUnwordsCharArrayCopy :: Handle -> Handle -> IO ()
1081+wordsUnwordsCharArrayCopy inh outh =
1082+ S.fold (FH.write outh)
1083+ $ SS.encodeLatin1
1084+ $ IUA.unwords
1085+ $ IUA.words
1086+ $ SS.decodeLatin1
1087+ $ S.unfold FH.read inh
1088+
1089+o_1_space_copy_read_group_ungroup ::
1090+ IORef Handles -> Handle -> Int -> [Benchmark]
1091+o_1_space_copy_read_group_ungroup href _ _ =
1092+ [ bgroup "copy/read/group-ungroup"
1093+ [ mkBench "US.unlines . S.splitOnSuffix ([Word8])" href $ do
1094+ Handles inh outh <- readIORef href
1095+ linesUnlinesCopy inh outh
1096+ , mkBench "S.interposeSuffix . S.splitOnSuffix(Array Word8)" href $ do
1097+ Handles inh outh <- readIORef href
1098+ linesUnlinesArrayWord8Copy inh outh
1099+ , mkBench "UA.unlines . UA.lines (Array Char)" href $ do
1100+ Handles inh outh <- readIORef href
1101+ linesUnlinesArrayCharCopy inh outh
1102+
1103+ , mkBench "S.interposeSuffix . S.wordsBy ([Word8])" href $ do
1104+ Handles inh outh <- readIORef href
1105+ wordsUnwordsCopyWord8 inh outh
1106+ , mkBench "US.unwords . S.wordsBy ([Char])" href $ do
1107+ Handles inh outh <- readIORef href
1108+ wordsUnwordsCopy inh outh
1109+ , mkBench "UA.unwords . UA.words (Array Char)" href $ do
1110+ Handles inh outh <- readIORef href
1111+ wordsUnwordsCharArrayCopy inh outh
1112+ ]
1113+ ]
1114+
1115+-------------------------------------------------------------------------------
1116+-- reduce with splitting transformations
1117+-------------------------------------------------------------------------------
1118+
1119+lf :: Word8
1120+lf = fromIntegral (ord '\n')
1121+
1122+toarr :: String -> A.Array Word8
1123+toarr = A.fromList . map (fromIntegral . ord)
1124+
1125+-- | Split on line feed.
1126+{-# INLINE splitOn #-}
1127+splitOn :: Handle -> IO Int
1128+splitOn inh =
1129+ (S.length $ S.splitOn (== lf) FL.drain
1130+ $ S.unfold FH.read inh) -- >>= print
1131+
1132+#ifdef INSPECTION
1133+inspect $ hasNoTypeClasses 'splitOn
1134+inspect $ 'splitOn `hasNoType` ''Step
1135+inspect $ 'splitOn `hasNoType` ''AT.FlattenState
1136+inspect $ 'splitOn `hasNoType` ''D.ConcatMapUState
1137+#endif
1138+
1139+-- | Split suffix on line feed.
1140+{-# INLINE splitOnSuffix #-}
1141+splitOnSuffix :: Handle -> IO Int
1142+splitOnSuffix inh =
1143+ (S.length $ S.splitOnSuffix (== lf) FL.drain
1144+ $ S.unfold FH.read inh) -- >>= print
1145+
1146+#ifdef INSPECTION
1147+inspect $ hasNoTypeClasses 'splitOnSuffix
1148+inspect $ 'splitOnSuffix `hasNoType` ''Step
1149+inspect $ 'splitOnSuffix `hasNoType` ''AT.FlattenState
1150+inspect $ 'splitOnSuffix `hasNoType` ''D.ConcatMapUState
1151+#endif
1152+
1153+-- | Split on line feed.
1154+{-# INLINE parseManySepBy #-}
1155+parseManySepBy :: Handle -> IO Int
1156+parseManySepBy inh =
1157+ (S.length $ IP.parseMany (PR.sliceSepBy (== lf) FL.drain)
1158+ (S.unfold FH.read inh)) -- >>= print
1159+
1160+-- | Words by space
1161+{-# INLINE wordsBy #-}
1162+wordsBy :: Handle -> IO Int
1163+wordsBy inh =
1164+ (S.length $ S.wordsBy isSp FL.drain
1165+ $ S.unfold FH.read inh) -- >>= print
1166+
1167+#ifdef INSPECTION
1168+inspect $ hasNoTypeClasses 'wordsBy
1169+inspect $ 'wordsBy `hasNoType` ''Step
1170+inspect $ 'wordsBy `hasNoType` ''AT.FlattenState
1171+inspect $ 'wordsBy `hasNoType` ''D.ConcatMapUState
1172+#endif
1173+
1174+-- | Split on a word8 sequence.
1175+{-# INLINE splitOnSeq #-}
1176+splitOnSeq :: String -> Handle -> IO Int
1177+splitOnSeq str inh =
1178+ (S.length $ IP.splitOnSeq (toarr str) FL.drain
1179+ $ S.unfold FH.read inh) -- >>= print
1180+
1181+#ifdef INSPECTION
1182+-- inspect $ hasNoTypeClasses 'splitOnSeq
1183+-- inspect $ 'splitOnSeq `hasNoType` ''Step
1184+-- inspect $ 'splitOnSeq `hasNoType` ''AT.FlattenState
1185+-- inspect $ 'splitOnSeq `hasNoType` ''D.ConcatMapUState
1186+#endif
1187+
1188+-- | Split on suffix sequence.
1189+{-# INLINE splitOnSuffixSeq #-}
1190+splitOnSuffixSeq :: String -> Handle -> IO Int
1191+splitOnSuffixSeq str inh =
1192+ (S.length $ IP.splitOnSuffixSeq (toarr str) FL.drain
1193+ $ S.unfold FH.read inh) -- >>= print
1194+
1195+#ifdef INSPECTION
1196+-- inspect $ hasNoTypeClasses 'splitOnSuffixSeq
1197+-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step
1198+-- inspect $ 'splitOnSuffixSeq `hasNoType` ''AT.FlattenState
1199+-- inspect $ 'splitOnSuffixSeq `hasNoType` ''D.ConcatMapUState
1200+#endif
1201+
1202+o_1_space_reduce_read_split ::
1203+ IORef Handles -> Handle -> Int -> [Benchmark]
1204+o_1_space_reduce_read_split href _ _ =
1205+ [ bgroup "reduce/read"
1206+ [ mkBench "S.parseMany (PR.sliceSepBy (== lf) FL.drain)" href $ do
1207+ Handles inh _ <- readIORef href
1208+ parseManySepBy inh
1209+ , mkBench "S.wordsBy isSpace FL.drain" href $ do
1210+ Handles inh _ <- readIORef href
1211+ wordsBy inh
1212+ , mkBench "S.splitOn (== lf) FL.drain" href $ do
1213+ Handles inh _ <- readIORef href
1214+ splitOn inh
1215+ , mkBench "S.splitOnSuffix (== lf) FL.drain" href $ do
1216+ Handles inh _ <- readIORef href
1217+ splitOnSuffix inh
1218+ , mkBench "S.splitOnSeq \"\" FL.drain" href $ do
1219+ Handles inh _ <- readIORef href
1220+ splitOnSeq "" inh
1221+ , mkBench "S.splitOnSuffixSeq \"\" FL.drain" href $ do
1222+ Handles inh _ <- readIORef href
1223+ splitOnSuffixSeq "" inh
1224+ , mkBench "S.splitOnSeq \"\\n\" FL.drain" href $ do
1225+ Handles inh _ <- readIORef href
1226+ splitOnSeq "\n" inh
1227+ , mkBench "S.splitOnSuffixSeq \"\\n\" FL.drain" href $ do
1228+ Handles inh _ <- readIORef href
1229+ splitOnSuffixSeq "\n" inh
1230+ , mkBench "S.splitOnSeq \"a\" FL.drain" href $ do
1231+ Handles inh _ <- readIORef href
1232+ splitOnSeq "a" inh
1233+ , mkBench "S.splitOnSeq \"\\r\\n\" FL.drain" href $ do
1234+ Handles inh _ <- readIORef href
1235+ splitOnSeq "\r\n" inh
1236+ , mkBench "S.splitOnSuffixSeq \"\\r\\n\" FL.drain" href $ do
1237+ Handles inh _ <- readIORef href
1238+ splitOnSuffixSeq "\r\n" inh
1239+ , mkBench "S.splitOnSeq \"aa\" FL.drain" href $ do
1240+ Handles inh _ <- readIORef href
1241+ splitOnSeq "aa" inh
1242+ , mkBench "S.splitOnSeq \"aaaa\" FL.drain" href $ do
1243+ Handles inh _ <- readIORef href
1244+ splitOnSeq "aaaa" inh
1245+ , mkBench "S.splitOnSeq \"abcdefgh\" FL.drain" href $ do
1246+ Handles inh _ <- readIORef href
1247+ splitOnSeq "abcdefgh" inh
1248+ , mkBench "S.splitOnSeq \"abcdefghi\" FL.drain" href $ do
1249+ Handles inh _ <- readIORef href
1250+ splitOnSeq "abcdefghi" inh
1251+ , mkBench "S.splitOnSeq \"catcatcatcatcat\" FL.drain" href $ do
1252+ Handles inh _ <- readIORef href
1253+ splitOnSeq "catcatcatcatcat" inh
1254+ , mkBench "S.splitOnSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
1255+ href $ do
1256+ Handles inh _ <- readIORef href
1257+ splitOnSeq "abcdefghijklmnopqrstuvwxyz" inh
1258+ , mkBench "S.splitOnSuffixSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
1259+ href $ do
1260+ Handles inh _ <- readIORef href
1261+ splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh
1262+ ]
1263+ ]
1264+
1265+-- | Split on a character sequence.
1266+{-# INLINE splitOnSeqUtf8 #-}
1267+splitOnSeqUtf8 :: String -> Handle -> IO Int
1268+splitOnSeqUtf8 str inh =
1269+ (S.length $ IP.splitOnSeq (A.fromList str) FL.drain
1270+ $ IUS.decodeUtf8ArraysLenient
1271+ $ IFH.toChunks inh) -- >>= print
1272+
1273+o_1_space_reduce_toChunks_split ::
1274+ IORef Handles -> Handle -> Int -> [Benchmark]
1275+o_1_space_reduce_toChunks_split href _ _ =
1276+ [ bgroup "reduce/toChunks"
1277+ [ mkBench ("S.splitOnSeqUtf8 \"abcdefgh\" FL.drain "
1278+ ++ ". US.decodeUtf8ArraysLenient") href $ do
1279+ Handles inh _ <- readIORef href
1280+ splitOnSeqUtf8 "abcdefgh" inh
1281+ , mkBench "S.splitOnSeqUtf8 \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
1282+ href $ do
1283+ Handles inh _ <- readIORef href
1284+ splitOnSeqUtf8 "abcdefghijklmnopqrstuvwxyz" inh
1285+ ]
1286+ ]
1287+
1288+-------------------------------------------------------------------------------
1289+--
1290+-------------------------------------------------------------------------------
1291+
1292+main :: IO ()
1293+main = do
1294+ (_, cfg, benches) <- parseCLIOpts defaultStreamSize
1295+
1296+ -- XXX The file is cached, so if the older file was a different size it
1297+ -- will not be correct
1298+ -- fileSize = blockSize * blockCount
1299+
1300+ r <- lookupEnv "Benchmark.FileSystem.Handle.InputFile"
1301+ (_, big) <-
1302+ case r of
1303+ Just inFileName -> return (inFileName, inFileName)
1304+ Nothing -> do
1305+ -- XXX will this work on windows/msys?
1306+ let cmd infile size =
1307+ "mkdir -p " ++ scratchDir
1308+ ++ "; test -e " ++ infile
1309+ ++ " || { echo \"creating input file " ++ infile
1310+ ++ "\" && dd if=/dev/random of=" ++ infile
1311+ ++ " bs=" ++ show blockSize
1312+ ++ " count=" ++ show (blockCount size)
1313+ ++ ";}"
1314+ runProcess_ (shell (cmd inFileSmall smallFileSize))
1315+ runProcess_ (shell (cmd inFileBig bigFileSize))
1316+ return (inFileSmall, inFileBig)
1317+
1318+ -- smallHandle <- openFile small ReadMode
1319+ bigHandle <- openFile big ReadMode
1320+ outHandle <- openFile outfile WriteMode
1321+ devNull <- openFile "/dev/null" WriteMode
1322+
1323+ -- ssize <- getFileSize small
1324+ bsize <- getFileSize big
1325+
1326+ ref <- newIORef $ Handles bigHandle outHandle
1327+ runMode (mode cfg) cfg benches (allBenchmarks ref devNull (fromIntegral bsize))
1328+
1329+ where
1330+
1331+ allBenchmarks env devNull bsize =
1332+ [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
1333+ [ o_1_space_read_chunked env devNull bsize
1334+ , o_1_space_copy_chunked env devNull bsize
1335+ , o_1_space_copy_exceptions_readChunks env devNull bsize
1336+ , o_1_space_copy_exceptions_toChunks env devNull bsize
1337+
1338+ , o_1_space_reduce_read env devNull bsize
1339+ , o_1_space_reduce_toBytes env devNull bsize
1340+ , o_1_space_reduce_read_grouped env devNull bsize
1341+ , o_1_space_reduce_read_split env devNull bsize
1342+ , o_1_space_reduce_toChunks_split env devNull bsize
1343+
1344+ , o_1_space_copy_read env devNull bsize
1345+ , o_1_space_copy_fromBytes env devNull bsize
1346+ , o_1_space_copy_read_exceptions env devNull bsize
1347+ , o_1_space_copy_stream_exceptions env devNull bsize
1348+ , o_1_space_copy_read_group_ungroup env devNull bsize
1349+ , o_1_space_copy_toChunks_group_ungroup env devNull bsize
1350+ ]
1351+ ]
benchmark/streamly-benchmarks.cabal+5−6
@@ -399,15 +399,14 @@ benchmark Memory.Array
399399-- FileIO Benchmarks
400400-------------------------------------------------------------------------------
401401
402−benchmark fileio
402+benchmark FileSystem.Handle
403403 import: bench-options
404404 type: exitcode-stdio-1.0
405− hs-source-dirs: .
406− main-is: FileIO.hs
407− other-modules: Streamly.Benchmark.FileIO.Array
408− , Streamly.Benchmark.FileIO.Stream
405+ hs-source-dirs: Streamly/Benchmark/FileSystem
406+ main-is: Handle.hs
409407 build-depends:
410− typed-process >= 0.2.3 && < 0.3
408+ typed-process >= 0.2.3 && < 0.3
409+ , directory >= 1.2.2 && < 1.4
411410
412411-------------------------------------------------------------------------------
413412-- benchmark comparison and presentation
streamly.cabal+1−1
@@ -114,7 +114,7 @@ extra-source-files:
114114 benchmark/Streamly/Benchmark/Data/Parser/*.hs
115115 benchmark/Streamly/Benchmark/Data/Prim/*.hs
116116 benchmark/Streamly/Benchmark/Data/Stream/*.hs
117− benchmark/Streamly/Benchmark/FileIO/*.hs
117+ benchmark/Streamly/Benchmark/FileSystem/*.hs
118118 benchmark/Streamly/Benchmark/Memory/*.hs
119119 benchmark/Streamly/Benchmark/Prelude/*.hs
120120 benchmark/lib/Streamly/Benchmark/*.hs