@@ -1,8 +1,7 @@
11-- |
22-- Module : Streamly.Benchmark.FileSystem.Handle
33-- Copyright : (c) 2019 Composewell Technologies
4−--
5−-- License : BSD3
4+-- License : BSD-3-Clause
65-- Maintainer : streamly@composewell.com
76-- Stability : experimental
87-- Portability : GHC
@@ -18,45 +17,15 @@
1817{-# LANGUAGE TemplateHaskell #-}
1918{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
2019#endif
20+import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv)
2121
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
22+import qualified Handle.ReadWrite as RW
23+import qualified Handle.Read as RO
4924
50−import Data.IORef
51−import Gauge hiding (env)
25+import Test.Tasty.Bench hiding (env)
26+import Prelude hiding (last, length)
5227import Streamly.Benchmark.Common
5328
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−
6029-------------------------------------------------------------------------------
6130--
6231-------------------------------------------------------------------------------
@@ -68,1284 +37,16 @@ moduleName = "FileSystem.Handle"
6837--
6938-------------------------------------------------------------------------------
7039
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−
129240main :: IO ()
129341main = 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))
42+ env <- mkHandleBenchEnv
43+ defaultMain (allBenchmarks env)
132844
132945 where
133046
1331− allBenchmarks env devNull bsize =
47+ allBenchmarks env =
133248 [ 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
49+ [ RO.allBenchmarks env
50+ , RW.allBenchmarks env
135051 ]
135152 ]