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