git.iko.soy/streamly
on e1ba45a help sign in
streamly/src/Streamly/Benchmark/FileIO/Stream.hs
473 lines 14 kB history raw
1-- |
2-- Module : Streamly.Benchmark.FileIO.Stream
3-- Copyright : (c) 2019 Composewell Technologies
4--
5-- License : BSD3
6-- Maintainer : harendra.kumar@gmail.com
7-- Stability : experimental
8-- Portability : GHC
10{-# LANGUAGE CPP #-}
12#ifdef __HADDOCK_VERSION__
13#undef INSPECTION
14#endif
16#ifdef INSPECTION
17{-# LANGUAGE TemplateHaskell #-}
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19#endif
21module Streamly.Benchmark.FileIO.Stream
22 (
23 -- * FileIO
24 last
25 , countBytes
26 , countLines
27 , countLinesU
28 , countWords
29 , sumBytes
30 , cat
31 , catStreamWrite
32 , copy
33 , linesUnlinesCopy
34 , wordsUnwordsCopyWord8
35 , wordsUnwordsCopy
36 , readWord8
37 , decodeChar8
38 , copyCodecChar8
39 , copyCodecUtf8
40 , decodeUtf8Lenient
41 , copyCodecUtf8Lenient
42 , chunksOf
43 , chunksOfD
44 , splitOn
45 , splitOnSuffix
46 , wordsBy
47 , splitOnSeq
48 , splitOnSeqUtf8
49 , splitOnSuffixSeq
50 )
51where
53import Data.Char (ord, chr)
54import Data.Word (Word8)
55import System.IO (Handle)
56import Prelude hiding (last, length)
58import qualified Streamly.FileSystem.Handle as FH
59import qualified Streamly.Internal.FileSystem.Handle as FH
60import qualified Streamly.Memory.Array as A
61import qualified Streamly.Internal.Memory.Array.Types as AT
62import qualified Streamly.Prelude as S
63import qualified Streamly.Data.Fold as FL
64import qualified Streamly.Data.String as SS
65import qualified Streamly.Internal.Data.Unfold as IUF
66import qualified Streamly.Internal.Prelude as IP
67import qualified Streamly.Streams.StreamD as D
69#ifdef INSPECTION
70import Foreign.Storable (Storable)
71import Streamly.Streams.StreamD.Type (Step(..), GroupState)
72import Test.Inspection
73#endif
75-- | Get the last byte from a file bytestream.
76{-# INLINE last #-}
77last :: Handle -> IO (Maybe Word8)
78last = S.last . FH.read
80#ifdef INSPECTION
81inspect $ hasNoTypeClasses 'last
82inspect $ 'last `hasNoType` ''Step
83inspect $ 'last `hasNoType` ''AT.FlattenState
84inspect $ 'last `hasNoType` ''D.ConcatMapUState
85#endif
87-- assert that flattenArrays constructors are not present
88-- | Count the number of bytes in a file.
89{-# INLINE countBytes #-}
90countBytes :: Handle -> IO Int
91countBytes = S.length . FH.read
93#ifdef INSPECTION
94inspect $ hasNoTypeClasses 'countBytes
95inspect $ 'countBytes `hasNoType` ''Step
96inspect $ 'countBytes `hasNoType` ''AT.FlattenState
97inspect $ 'countBytes `hasNoType` ''D.ConcatMapUState
98#endif
100-- | Count the number of lines in a file.
101{-# INLINE countLines #-}
102countLines :: Handle -> IO Int
103countLines =
104 S.length
105 . SS.foldLines FL.drain
106 . SS.decodeChar8
107 . FH.read
109#ifdef INSPECTION
110inspect $ hasNoTypeClasses 'countLines
111inspect $ 'countLines `hasNoType` ''Step
112inspect $ 'countLines `hasNoType` ''AT.FlattenState
113inspect $ 'countLines `hasNoType` ''D.ConcatMapUState
114#endif
116-- | Count the number of words in a file.
117{-# INLINE countWords #-}
118countWords :: Handle -> IO Int
119countWords =
120 S.length
121 . SS.foldWords FL.drain
122 . SS.decodeChar8
123 . FH.read
125#ifdef INSPECTION
126inspect $ hasNoTypeClasses 'countWords
127-- inspect $ 'countWords `hasNoType` ''Step
128-- inspect $ 'countWords `hasNoType` ''D.ConcatMapUState
129#endif
131-- | Count the number of lines in a file.
132{-# INLINE countLinesU #-}
133countLinesU :: Handle -> IO Int
134countLinesU inh =
135 S.length
136 $ SS.foldLines FL.drain
137 $ SS.decodeChar8
138 $ IP.concatMapU AT.readU (FH.readArrays inh)
140#ifdef INSPECTION
141inspect $ hasNoTypeClasses 'countLinesU
142inspect $ 'countLinesU `hasNoType` ''Step
143inspect $ 'countLinesU `hasNoType` ''D.ConcatMapUState
144#endif
146-- | Sum the bytes in a file.
147{-# INLINE sumBytes #-}
148sumBytes :: Handle -> IO Word8
149sumBytes = S.sum . FH.read
151#ifdef INSPECTION
152inspect $ hasNoTypeClasses 'sumBytes
153inspect $ 'sumBytes `hasNoType` ''Step
154inspect $ 'sumBytes `hasNoType` ''AT.FlattenState
155inspect $ 'sumBytes `hasNoType` ''D.ConcatMapUState
156#endif
158-- | Send the file contents to /dev/null
159{-# INLINE cat #-}
160cat :: Handle -> Handle -> IO ()
161cat devNull inh = S.runFold (FH.write devNull) $ FH.read inh
163#ifdef INSPECTION
164inspect $ hasNoTypeClasses 'cat
165inspect $ 'cat `hasNoType` ''Step
166inspect $ 'cat `hasNoType` ''AT.FlattenState
167inspect $ 'cat `hasNoType` ''D.ConcatMapUState
168#endif
170-- | Send the file contents to /dev/null
171{-# INLINE catStreamWrite #-}
172catStreamWrite :: Handle -> Handle -> IO ()
173catStreamWrite devNull inh = FH.writeS devNull $ FH.read inh
175#ifdef INSPECTION
176inspect $ hasNoTypeClasses 'catStreamWrite
177inspect $ 'catStreamWrite `hasNoType` ''Step
178inspect $ 'catStreamWrite `hasNoType` ''AT.FlattenState
179inspect $ 'catStreamWrite `hasNoType` ''D.ConcatMapUState
180#endif
182-- | Copy file
183{-# INLINE copy #-}
184copy :: Handle -> Handle -> IO ()
185copy inh outh = S.runFold (FH.write outh) (FH.read inh)
187#ifdef INSPECTION
188inspect $ hasNoTypeClasses 'copy
189inspect $ 'copy `hasNoType` ''Step
190inspect $ 'copy `hasNoType` ''AT.FlattenState
191inspect $ 'copy `hasNoType` ''D.ConcatMapUState
192#endif
194{-# INLINE readWord8 #-}
195readWord8 :: Handle -> IO ()
196readWord8 inh = S.drain $ FH.read inh
198{-# INLINE decodeChar8 #-}
199decodeChar8 :: Handle -> IO ()
200decodeChar8 inh =
201 S.drain
202 $ SS.decodeChar8
203 $ FH.read inh
205-- | Copy file
206{-# INLINE copyCodecChar8 #-}
207copyCodecChar8 :: Handle -> Handle -> IO ()
208copyCodecChar8 inh outh =
209 S.runFold (FH.write outh)
210 $ SS.encodeChar8
211 $ SS.decodeChar8
212 $ FH.read inh
214#ifdef INSPECTION
215inspect $ hasNoTypeClasses 'copyCodecChar8
216inspect $ 'copyCodecChar8 `hasNoType` ''Step
217inspect $ 'copyCodecChar8 `hasNoType` ''AT.FlattenState
218inspect $ 'copyCodecChar8 `hasNoType` ''D.ConcatMapUState
219#endif
221{-# INLINE decodeUtf8Lenient #-}
222decodeUtf8Lenient :: Handle -> IO ()
223decodeUtf8Lenient inh =
224 S.drain
225 $ SS.decodeUtf8Lenient
226 $ FH.read inh
228#ifdef INSPECTION
229inspect $ hasNoTypeClasses 'decodeUtf8Lenient
230-- inspect $ 'decodeUtf8Lenient `hasNoType` ''Step
231-- inspect $ 'decodeUtf8Lenient `hasNoType` ''AT.FlattenState
232-- inspect $ 'decodeUtf8Lenient `hasNoType` ''D.ConcatMapUState
233#endif
235-- | Copy file
236{-# INLINE copyCodecUtf8 #-}
237copyCodecUtf8 :: Handle -> Handle -> IO ()
238copyCodecUtf8 inh outh =
239 S.runFold (FH.write outh)
240 $ SS.encodeUtf8
241 $ SS.decodeUtf8
242 $ FH.read inh
244#ifdef INSPECTION
245inspect $ hasNoTypeClasses 'copyCodecUtf8
246-- inspect $ 'copyCodecUtf8 `hasNoType` ''Step
247-- inspect $ 'copyCodecUtf8 `hasNoType` ''AT.FlattenState
248-- inspect $ 'copyCodecUtf8 `hasNoType` ''D.ConcatMapUState
249#endif
251-- | Copy file
252{-# INLINE copyCodecUtf8Lenient #-}
253copyCodecUtf8Lenient :: Handle -> Handle -> IO ()
254copyCodecUtf8Lenient inh outh =
255 S.runFold (FH.write outh)
256 $ SS.encodeUtf8
257 $ SS.decodeUtf8Lenient
258 $ FH.read inh
260#ifdef INSPECTION
261inspect $ hasNoTypeClasses 'copyCodecUtf8Lenient
262-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''Step
263-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''AT.FlattenState
264-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''D.ConcatMapUState
265#endif
267-- | Slice in chunks of size n and get the count of chunks.
268{-# INLINE chunksOf #-}
269chunksOf :: Int -> Handle -> IO Int
270chunksOf n inh =
271 -- writeNUnsafe gives 2.5x boost here over writeN.
272 S.length $ S.chunksOf n (AT.writeNUnsafe n) (FH.read inh)
274#ifdef INSPECTION
275inspect $ hasNoTypeClasses 'chunksOf
276inspect $ 'chunksOf `hasNoType` ''Step
277inspect $ 'chunksOf `hasNoType` ''AT.FlattenState
278inspect $ 'chunksOf `hasNoType` ''D.ConcatMapUState
279inspect $ 'chunksOf `hasNoType` ''GroupState
280#endif
282-- This is to make sure that the concatMap in FH.read, groupsOf and foldlM'
283-- together can fuse.
284--
285-- | Slice in chunks of size n and get the count of chunks.
286{-# INLINE chunksOfD #-}
287chunksOfD :: Int -> Handle -> IO Int
288chunksOfD n inh =
289 D.foldlM' (\i _ -> return $ i + 1) 0
290 $ D.groupsOf n (AT.writeNUnsafe n)
291 $ D.fromStreamK (FH.read inh)
293#ifdef INSPECTION
294inspect $ hasNoTypeClasses 'chunksOf
295inspect $ 'chunksOf `hasNoType` ''Step
296inspect $ 'chunksOfD `hasNoType` ''GroupState
297inspect $ 'chunksOfD `hasNoType` ''AT.FlattenState
298inspect $ 'chunksOfD `hasNoType` ''D.ConcatMapUState
299#endif
301-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion
302-- | Lines and unlines
303{-# INLINE linesUnlinesCopy #-}
304linesUnlinesCopy :: Handle -> Handle -> IO ()
305linesUnlinesCopy inh outh =
306 S.runFold (FH.write outh)
307 $ SS.encodeChar8
308 $ SS.unlines
309 $ SS.lines
310 $ SS.decodeChar8
311 $ FH.read inh
313#ifdef INSPECTION
314inspect $ hasNoTypeClassesExcept 'linesUnlinesCopy [''Storable]
315-- inspect $ 'linesUnlinesCopy `hasNoType` ''Step
316-- inspect $ 'linesUnlinesCopy `hasNoType` ''AT.FlattenState
317-- inspect $ 'linesUnlinesCopy `hasNoType` ''D.ConcatMapUState
318#endif
320foreign import ccall unsafe "u_iswspace"
321 iswspace :: Int -> Int
323-- Code copied from base/Data.Char to INLINE it
324{-# INLINE isSpace #-}
325isSpace :: Char -> Bool
326-- isSpace includes non-breaking space
327-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints
328-- at or below 0x377 have been assigned, so we shouldn't have to worry about
329-- any new spaces appearing below there. It would probably be best to
330-- use branchless ||, but currently the eqLit transformation will undo that,
331-- so we'll do it like this until there's a way around that.
332isSpace c
333 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
334 | otherwise = iswspace (ord c) /= 0
335 where
336 uc = fromIntegral (ord c) :: Word
338{-# INLINE isSp #-}
339isSp :: Word8 -> Bool
340isSp = isSpace . chr . fromIntegral
342-- | Word, unwords and copy
343{-# INLINE wordsUnwordsCopyWord8 #-}
344wordsUnwordsCopyWord8 :: Handle -> Handle -> IO ()
345wordsUnwordsCopyWord8 inh outh =
346 S.runFold (FH.write outh)
347 $ IP.concatMapU IUF.fromList
348 $ S.intersperse [32]
349 $ S.wordsBy isSp FL.toList
350 $ FH.read inh
352#ifdef INSPECTION
353inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8
354-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''Step
355-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''D.ConcatMapUState
356#endif
358-- | Word, unwords and copy
359{-# INLINE wordsUnwordsCopy #-}
360wordsUnwordsCopy :: Handle -> Handle -> IO ()
361wordsUnwordsCopy inh outh =
362 S.runFold (FH.write outh)
363 $ SS.encodeChar8
364 $ IP.concatMapU IUF.fromList
365 $ S.intersperse " "
366 -- Array allocation is too expensive for such small strings. So just use
367 -- lists instead.
368 --
369 -- -- $ SS.unwords
370 -- -- $ SS.words
371 --
372 -- XXX This pipeline does not fuse with wordsBy but fuses with splitOn
373 -- with -funfolding-use-threshold=300. With wordsBy it does not fuse
374 -- even with high limits for inlining and spec-constr ghc options. With
375 -- -funfolding-use-threshold=400 it performs pretty well and there
376 -- is no evidence in the core that a join point involving Step
377 -- constructors is not getting inlined. Not being able to fuse at all in
378 -- this case could be an unknown issue, need more investigation.
379 $ S.wordsBy isSpace FL.toList
380 -- -- $ S.splitOn isSpace FL.toList
381 $ SS.decodeChar8
382 $ FH.read inh
384#ifdef INSPECTION
385-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy
386-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step
387-- inspect $ 'wordsUnwordsCopy `hasNoType` ''AT.FlattenState
388-- inspect $ 'wordsUnwordsCopy `hasNoType` ''D.ConcatMapUState
389#endif
391lf :: Word8
392lf = fromIntegral (ord '\n')
394toarr :: String -> A.Array Word8
395toarr = A.fromList . map (fromIntegral . ord)
397-- | Split on line feed.
398{-# INLINE splitOn #-}
399splitOn :: Handle -> IO Int
400splitOn inh =
401 (S.length $ S.splitOn (== lf) FL.drain
402 $ FH.read inh) -- >>= print
404#ifdef INSPECTION
405inspect $ hasNoTypeClasses 'splitOn
406inspect $ 'splitOn `hasNoType` ''Step
407inspect $ 'splitOn `hasNoType` ''AT.FlattenState
408inspect $ 'splitOn `hasNoType` ''D.ConcatMapUState
409#endif
411-- | Split suffix on line feed.
412{-# INLINE splitOnSuffix #-}
413splitOnSuffix :: Handle -> IO Int
414splitOnSuffix inh =
415 (S.length $ S.splitOnSuffix (== lf) FL.drain
416 $ FH.read inh) -- >>= print
418#ifdef INSPECTION
419inspect $ hasNoTypeClasses 'splitOnSuffix
420inspect $ 'splitOnSuffix `hasNoType` ''Step
421inspect $ 'splitOnSuffix `hasNoType` ''AT.FlattenState
422inspect $ 'splitOnSuffix `hasNoType` ''D.ConcatMapUState
423#endif
425-- | Words by space
426{-# INLINE wordsBy #-}
427wordsBy :: Handle -> IO Int
428wordsBy inh =
429 (S.length $ S.wordsBy isSp FL.drain
430 $ FH.read inh) -- >>= print
432#ifdef INSPECTION
433inspect $ hasNoTypeClasses 'wordsBy
434inspect $ 'wordsBy `hasNoType` ''Step
435inspect $ 'wordsBy `hasNoType` ''AT.FlattenState
436inspect $ 'wordsBy `hasNoType` ''D.ConcatMapUState
437#endif
439-- | Split on a word8 sequence.
440{-# INLINE splitOnSeq #-}
441splitOnSeq :: String -> Handle -> IO Int
442splitOnSeq str inh =
443 (S.length $ IP.splitOnSeq (toarr str) FL.drain
444 $ FH.read inh) -- >>= print
446#ifdef INSPECTION
447inspect $ hasNoTypeClasses 'splitOnSeq
448-- inspect $ 'splitOnSeq `hasNoType` ''Step
449-- inspect $ 'splitOnSeq `hasNoType` ''AT.FlattenState
450-- inspect $ 'splitOnSeq `hasNoType` ''D.ConcatMapUState
451#endif
453-- | Split on a character sequence.
454{-# INLINE splitOnSeqUtf8 #-}
455splitOnSeqUtf8 :: String -> Handle -> IO Int
456splitOnSeqUtf8 str inh =
457 (S.length $ IP.splitOnSeq (A.fromList str) FL.drain
458 $ SS.decodeUtf8ArraysLenient
459 $ FH.readArrays inh) -- >>= print
461-- | Split on suffix sequence.
462{-# INLINE splitOnSuffixSeq #-}
463splitOnSuffixSeq :: String -> Handle -> IO Int
464splitOnSuffixSeq str inh =
465 (S.length $ IP.splitOnSuffixSeq (toarr str) FL.drain
466 $ FH.read inh) -- >>= print
468#ifdef INSPECTION
469inspect $ hasNoTypeClasses 'splitOnSuffixSeq
470-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step
471-- inspect $ 'splitOnSuffixSeq `hasNoType` ''AT.FlattenState
472-- inspect $ 'splitOnSuffixSeq `hasNoType` ''D.ConcatMapUState
473#endif