git.iko.soy/streamly
on master help sign in
Reorganize, move the FileIO benchmarks
3d033aeHarendra Kumar
benchmark/FileIO.hsdeleted−349
compare with master
unifiedsplit
@@ -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
399-- FileIO Benchmarks
399-- FileIO Benchmarks
400-------------------------------------------------------------------------------
400-------------------------------------------------------------------------------
401
401
402−benchmark fileio
402+benchmark FileSystem.Handle
403 import: bench-options
403 import: bench-options
404 type: exitcode-stdio-1.0
404 type: exitcode-stdio-1.0
405− hs-source-dirs: .
405+ hs-source-dirs: Streamly/Benchmark/FileSystem
406− main-is: FileIO.hs
406+ main-is: Handle.hs
407− other-modules: Streamly.Benchmark.FileIO.Array
408− , Streamly.Benchmark.FileIO.Stream
409 build-depends:
407 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
411
410
412-------------------------------------------------------------------------------
411-------------------------------------------------------------------------------
413-- benchmark comparison and presentation
412-- benchmark comparison and presentation
streamly.cabal+1−1
@@ -114,7 +114,7 @@ extra-source-files:
114 benchmark/Streamly/Benchmark/Data/Parser/*.hs
114 benchmark/Streamly/Benchmark/Data/Parser/*.hs
115 benchmark/Streamly/Benchmark/Data/Prim/*.hs
115 benchmark/Streamly/Benchmark/Data/Prim/*.hs
116 benchmark/Streamly/Benchmark/Data/Stream/*.hs
116 benchmark/Streamly/Benchmark/Data/Stream/*.hs
117− benchmark/Streamly/Benchmark/FileIO/*.hs
117+ benchmark/Streamly/Benchmark/FileSystem/*.hs
118 benchmark/Streamly/Benchmark/Memory/*.hs
118 benchmark/Streamly/Benchmark/Memory/*.hs
119 benchmark/Streamly/Benchmark/Prelude/*.hs
119 benchmark/Streamly/Benchmark/Prelude/*.hs
120 benchmark/lib/Streamly/Benchmark/*.hs
120 benchmark/lib/Streamly/Benchmark/*.hs