git.iko.soy/streamly
on d6f08aa help sign in
streamly/src/Streamly/Benchmark/FileIO/Stream.hs
472 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.FileSystem.Handle.Internal as FH
60import qualified Streamly.Memory.Array as A
61import qualified Streamly.Memory.Array.Types as AT
62import qualified Streamly.Prelude.Internal as S
63import qualified Streamly.Fold as FL
64import qualified Streamly.Data.String as SS
65import qualified Streamly.Internal as Internal
66import qualified Streamly.Streams.StreamD as D
68#ifdef INSPECTION
69import Foreign.Storable (Storable)
70import Streamly.Streams.StreamD.Type (Step(..), GroupState)
71import Test.Inspection
72#endif
74-- | Get the last byte from a file bytestream.
75{-# INLINE last #-}
76last :: Handle -> IO (Maybe Word8)
77last = S.last . FH.read
79#ifdef INSPECTION
80inspect $ hasNoTypeClasses 'last
81inspect $ 'last `hasNoType` ''Step
82inspect $ 'last `hasNoType` ''AT.FlattenState
83inspect $ 'last `hasNoType` ''D.ConcatMapUState
84#endif
86-- assert that flattenArrays constructors are not present
87-- | Count the number of bytes in a file.
88{-# INLINE countBytes #-}
89countBytes :: Handle -> IO Int
90countBytes = S.length . FH.read
92#ifdef INSPECTION
93inspect $ hasNoTypeClasses 'countBytes
94inspect $ 'countBytes `hasNoType` ''Step
95inspect $ 'countBytes `hasNoType` ''AT.FlattenState
96inspect $ 'countBytes `hasNoType` ''D.ConcatMapUState
97#endif
99-- | Count the number of lines in a file.
100{-# INLINE countLines #-}
101countLines :: Handle -> IO Int
102countLines =
103 S.length
104 . SS.foldLines FL.drain
105 . SS.decodeChar8
106 . FH.read
108#ifdef INSPECTION
109inspect $ hasNoTypeClasses 'countLines
110inspect $ 'countLines `hasNoType` ''Step
111inspect $ 'countLines `hasNoType` ''AT.FlattenState
112inspect $ 'countLines `hasNoType` ''D.ConcatMapUState
113#endif
115-- | Count the number of words in a file.
116{-# INLINE countWords #-}
117countWords :: Handle -> IO Int
118countWords =
119 S.length
120 . SS.foldWords FL.drain
121 . SS.decodeChar8
122 . FH.read
124#ifdef INSPECTION
125inspect $ hasNoTypeClasses 'countWords
126-- inspect $ 'countWords `hasNoType` ''Step
127-- inspect $ 'countWords `hasNoType` ''D.ConcatMapUState
128#endif
130-- | Count the number of lines in a file.
131{-# INLINE countLinesU #-}
132countLinesU :: Handle -> IO Int
133countLinesU inh =
134 S.length
135 $ SS.foldLines FL.drain
136 $ SS.decodeChar8
137 $ Internal.concatMapU Internal.readU (FH.readArrays inh)
139#ifdef INSPECTION
140inspect $ hasNoTypeClasses 'countLinesU
141inspect $ 'countLinesU `hasNoType` ''Step
142inspect $ 'countLinesU `hasNoType` ''D.ConcatMapUState
143#endif
145-- | Sum the bytes in a file.
146{-# INLINE sumBytes #-}
147sumBytes :: Handle -> IO Word8
148sumBytes = S.sum . FH.read
150#ifdef INSPECTION
151inspect $ hasNoTypeClasses 'sumBytes
152inspect $ 'sumBytes `hasNoType` ''Step
153inspect $ 'sumBytes `hasNoType` ''AT.FlattenState
154inspect $ 'sumBytes `hasNoType` ''D.ConcatMapUState
155#endif
157-- | Send the file contents to /dev/null
158{-# INLINE cat #-}
159cat :: Handle -> Handle -> IO ()
160cat devNull inh = S.runFold (FH.write devNull) $ FH.read inh
162#ifdef INSPECTION
163inspect $ hasNoTypeClasses 'cat
164inspect $ 'cat `hasNoType` ''Step
165inspect $ 'cat `hasNoType` ''AT.FlattenState
166inspect $ 'cat `hasNoType` ''D.ConcatMapUState
167#endif
169-- | Send the file contents to /dev/null
170{-# INLINE catStreamWrite #-}
171catStreamWrite :: Handle -> Handle -> IO ()
172catStreamWrite devNull inh = FH.writeS devNull $ FH.read inh
174#ifdef INSPECTION
175inspect $ hasNoTypeClasses 'catStreamWrite
176inspect $ 'catStreamWrite `hasNoType` ''Step
177inspect $ 'catStreamWrite `hasNoType` ''AT.FlattenState
178inspect $ 'catStreamWrite `hasNoType` ''D.ConcatMapUState
179#endif
181-- | Copy file
182{-# INLINE copy #-}
183copy :: Handle -> Handle -> IO ()
184copy inh outh = S.runFold (FH.write outh) (FH.read inh)
186#ifdef INSPECTION
187inspect $ hasNoTypeClasses 'copy
188inspect $ 'copy `hasNoType` ''Step
189inspect $ 'copy `hasNoType` ''AT.FlattenState
190inspect $ 'copy `hasNoType` ''D.ConcatMapUState
191#endif
193{-# INLINE readWord8 #-}
194readWord8 :: Handle -> IO ()
195readWord8 inh = S.drain $ FH.read inh
197{-# INLINE decodeChar8 #-}
198decodeChar8 :: Handle -> IO ()
199decodeChar8 inh =
200 S.drain
201 $ SS.decodeChar8
202 $ FH.read inh
204-- | Copy file
205{-# INLINE copyCodecChar8 #-}
206copyCodecChar8 :: Handle -> Handle -> IO ()
207copyCodecChar8 inh outh =
208 S.runFold (FH.write outh)
209 $ SS.encodeChar8
210 $ SS.decodeChar8
211 $ FH.read inh
213#ifdef INSPECTION
214inspect $ hasNoTypeClasses 'copyCodecChar8
215inspect $ 'copyCodecChar8 `hasNoType` ''Step
216inspect $ 'copyCodecChar8 `hasNoType` ''AT.FlattenState
217inspect $ 'copyCodecChar8 `hasNoType` ''D.ConcatMapUState
218#endif
220{-# INLINE decodeUtf8Lenient #-}
221decodeUtf8Lenient :: Handle -> IO ()
222decodeUtf8Lenient inh =
223 S.drain
224 $ SS.decodeUtf8Lenient
225 $ FH.read inh
227#ifdef INSPECTION
228inspect $ hasNoTypeClasses 'decodeUtf8Lenient
229-- inspect $ 'decodeUtf8Lenient `hasNoType` ''Step
230-- inspect $ 'decodeUtf8Lenient `hasNoType` ''AT.FlattenState
231-- inspect $ 'decodeUtf8Lenient `hasNoType` ''D.ConcatMapUState
232#endif
234-- | Copy file
235{-# INLINE copyCodecUtf8 #-}
236copyCodecUtf8 :: Handle -> Handle -> IO ()
237copyCodecUtf8 inh outh =
238 S.runFold (FH.write outh)
239 $ SS.encodeUtf8
240 $ SS.decodeUtf8
241 $ FH.read inh
243#ifdef INSPECTION
244inspect $ hasNoTypeClasses 'copyCodecUtf8
245-- inspect $ 'copyCodecUtf8 `hasNoType` ''Step
246-- inspect $ 'copyCodecUtf8 `hasNoType` ''AT.FlattenState
247-- inspect $ 'copyCodecUtf8 `hasNoType` ''D.ConcatMapUState
248#endif
250-- | Copy file
251{-# INLINE copyCodecUtf8Lenient #-}
252copyCodecUtf8Lenient :: Handle -> Handle -> IO ()
253copyCodecUtf8Lenient inh outh =
254 S.runFold (FH.write outh)
255 $ SS.encodeUtf8
256 $ SS.decodeUtf8Lenient
257 $ FH.read inh
259#ifdef INSPECTION
260inspect $ hasNoTypeClasses 'copyCodecUtf8Lenient
261-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''Step
262-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''AT.FlattenState
263-- inspect $ 'copyCodecUtf8Lenient `hasNoType` ''D.ConcatMapUState
264#endif
266-- | Slice in chunks of size n and get the count of chunks.
267{-# INLINE chunksOf #-}
268chunksOf :: Int -> Handle -> IO Int
269chunksOf n inh =
270 -- writeNUnsafe gives 2.5x boost here over writeN.
271 S.length $ S.chunksOf n (AT.writeNUnsafe n) (FH.read inh)
273#ifdef INSPECTION
274inspect $ hasNoTypeClasses 'chunksOf
275inspect $ 'chunksOf `hasNoType` ''Step
276inspect $ 'chunksOf `hasNoType` ''AT.FlattenState
277inspect $ 'chunksOf `hasNoType` ''D.ConcatMapUState
278inspect $ 'chunksOf `hasNoType` ''GroupState
279#endif
281-- This is to make sure that the concatMap in FH.read, groupsOf and foldlM'
282-- together can fuse.
283--
284-- | Slice in chunks of size n and get the count of chunks.
285{-# INLINE chunksOfD #-}
286chunksOfD :: Int -> Handle -> IO Int
287chunksOfD n inh =
288 D.foldlM' (\i _ -> return $ i + 1) 0
289 $ D.groupsOf n (AT.writeNUnsafe n)
290 $ D.fromStreamK (FH.read inh)
292#ifdef INSPECTION
293inspect $ hasNoTypeClasses 'chunksOf
294inspect $ 'chunksOf `hasNoType` ''Step
295inspect $ 'chunksOfD `hasNoType` ''GroupState
296inspect $ 'chunksOfD `hasNoType` ''AT.FlattenState
297inspect $ 'chunksOfD `hasNoType` ''D.ConcatMapUState
298#endif
300-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion
301-- | Lines and unlines
302{-# INLINE linesUnlinesCopy #-}
303linesUnlinesCopy :: Handle -> Handle -> IO ()
304linesUnlinesCopy inh outh =
305 S.runFold (FH.write outh)
306 $ SS.encodeChar8
307 $ SS.unlines
308 $ SS.lines
309 $ SS.decodeChar8
310 $ FH.read inh
312#ifdef INSPECTION
313inspect $ hasNoTypeClassesExcept 'linesUnlinesCopy [''Storable]
314-- inspect $ 'linesUnlinesCopy `hasNoType` ''Step
315-- inspect $ 'linesUnlinesCopy `hasNoType` ''AT.FlattenState
316-- inspect $ 'linesUnlinesCopy `hasNoType` ''D.ConcatMapUState
317#endif
319foreign import ccall unsafe "u_iswspace"
320 iswspace :: Int -> Int
322-- Code copied from base/Data.Char to INLINE it
323{-# INLINE isSpace #-}
324isSpace :: Char -> Bool
325-- isSpace includes non-breaking space
326-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints
327-- at or below 0x377 have been assigned, so we shouldn't have to worry about
328-- any new spaces appearing below there. It would probably be best to
329-- use branchless ||, but currently the eqLit transformation will undo that,
330-- so we'll do it like this until there's a way around that.
331isSpace c
332 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
333 | otherwise = iswspace (ord c) /= 0
334 where
335 uc = fromIntegral (ord c) :: Word
337{-# INLINE isSp #-}
338isSp :: Word8 -> Bool
339isSp = isSpace . chr . fromIntegral
341-- | Word, unwords and copy
342{-# INLINE wordsUnwordsCopyWord8 #-}
343wordsUnwordsCopyWord8 :: Handle -> Handle -> IO ()
344wordsUnwordsCopyWord8 inh outh =
345 S.runFold (FH.write outh)
346 $ Internal.concatMapU Internal.fromList
347 $ S.intersperse [32]
348 $ S.wordsBy isSp FL.toList
349 $ FH.read inh
351#ifdef INSPECTION
352inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8
353-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''Step
354-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''D.ConcatMapUState
355#endif
357-- | Word, unwords and copy
358{-# INLINE wordsUnwordsCopy #-}
359wordsUnwordsCopy :: Handle -> Handle -> IO ()
360wordsUnwordsCopy inh outh =
361 S.runFold (FH.write outh)
362 $ SS.encodeChar8
363 $ Internal.concatMapU Internal.fromList
364 $ S.intersperse " "
365 -- Array allocation is too expensive for such small strings. So just use
366 -- lists instead.
367 --
368 -- -- $ SS.unwords
369 -- -- $ SS.words
370 --
371 -- XXX This pipeline does not fuse with wordsBy but fuses with splitOn
372 -- with -funfolding-use-threshold=300. With wordsBy it does not fuse
373 -- even with high limits for inlining and spec-constr ghc options. With
374 -- -funfolding-use-threshold=400 it performs pretty well and there
375 -- is no evidence in the core that a join point involving Step
376 -- constructors is not getting inlined. Not being able to fuse at all in
377 -- this case could be an unknown issue, need more investigation.
378 $ S.wordsBy isSpace FL.toList
379 -- -- $ S.splitOn isSpace FL.toList
380 $ SS.decodeChar8
381 $ FH.read inh
383#ifdef INSPECTION
384-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy
385-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step
386-- inspect $ 'wordsUnwordsCopy `hasNoType` ''AT.FlattenState
387-- inspect $ 'wordsUnwordsCopy `hasNoType` ''D.ConcatMapUState
388#endif
390lf :: Word8
391lf = fromIntegral (ord '\n')
393toarr :: String -> A.Array Word8
394toarr = A.fromList . map (fromIntegral . ord)
396-- | Split on line feed.
397{-# INLINE splitOn #-}
398splitOn :: Handle -> IO Int
399splitOn inh =
400 (S.length $ S.splitOn (== lf) FL.drain
401 $ FH.read inh) -- >>= print
403#ifdef INSPECTION
404inspect $ hasNoTypeClasses 'splitOn
405inspect $ 'splitOn `hasNoType` ''Step
406inspect $ 'splitOn `hasNoType` ''AT.FlattenState
407inspect $ 'splitOn `hasNoType` ''D.ConcatMapUState
408#endif
410-- | Split suffix on line feed.
411{-# INLINE splitOnSuffix #-}
412splitOnSuffix :: Handle -> IO Int
413splitOnSuffix inh =
414 (S.length $ S.splitOnSuffix (== lf) FL.drain
415 $ FH.read inh) -- >>= print
417#ifdef INSPECTION
418inspect $ hasNoTypeClasses 'splitOnSuffix
419inspect $ 'splitOnSuffix `hasNoType` ''Step
420inspect $ 'splitOnSuffix `hasNoType` ''AT.FlattenState
421inspect $ 'splitOnSuffix `hasNoType` ''D.ConcatMapUState
422#endif
424-- | Words by space
425{-# INLINE wordsBy #-}
426wordsBy :: Handle -> IO Int
427wordsBy inh =
428 (S.length $ S.wordsBy isSp FL.drain
429 $ FH.read inh) -- >>= print
431#ifdef INSPECTION
432inspect $ hasNoTypeClasses 'wordsBy
433inspect $ 'wordsBy `hasNoType` ''Step
434inspect $ 'wordsBy `hasNoType` ''AT.FlattenState
435inspect $ 'wordsBy `hasNoType` ''D.ConcatMapUState
436#endif
438-- | Split on a word8 sequence.
439{-# INLINE splitOnSeq #-}
440splitOnSeq :: String -> Handle -> IO Int
441splitOnSeq str inh =
442 (S.length $ Internal.splitOnSeq (toarr str) FL.drain
443 $ FH.read inh) -- >>= print
445#ifdef INSPECTION
446inspect $ hasNoTypeClasses 'splitOnSeq
447-- inspect $ 'splitOnSeq `hasNoType` ''Step
448-- inspect $ 'splitOnSeq `hasNoType` ''AT.FlattenState
449-- inspect $ 'splitOnSeq `hasNoType` ''D.ConcatMapUState
450#endif
452-- | Split on a character sequence.
453{-# INLINE splitOnSeqUtf8 #-}
454splitOnSeqUtf8 :: String -> Handle -> IO Int
455splitOnSeqUtf8 str inh =
456 (S.length $ Internal.splitOnSeq (A.fromList str) FL.drain
457 $ SS.decodeUtf8ArraysLenient
458 $ FH.readArrays inh) -- >>= print
460-- | Split on suffix sequence.
461{-# INLINE splitOnSuffixSeq #-}
462splitOnSuffixSeq :: String -> Handle -> IO Int
463splitOnSuffixSeq str inh =
464 (S.length $ Internal.splitOnSuffixSeq (toarr str) FL.drain
465 $ FH.read inh) -- >>= print
467#ifdef INSPECTION
468inspect $ hasNoTypeClasses 'splitOnSuffixSeq
469-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step
470-- inspect $ 'splitOnSuffixSeq `hasNoType` ''AT.FlattenState
471-- inspect $ 'splitOnSuffixSeq `hasNoType` ''D.ConcatMapUState
472#endif