git.iko.soy/streamly
on fe28607 help sign in
streamly/benchmark/Streamly/Benchmark/Data/Array/Stream.hs
299 lines 10.0 kB history raw
1{-# OPTIONS_GHC -Wno-deprecations #-}
3-- |
4-- Module : Streamly.Benchmark.Data.ParserD
5-- Copyright : (c) 2020 Composewell Technologies
6--
7-- License : BSD-3-Clause
8-- Maintainer : streamly@composewell.com
10{-# LANGUAGE CPP #-}
11{-# LANGUAGE FlexibleContexts #-}
12{-# LANGUAGE ScopedTypeVariables #-}
14#ifdef __HADDOCK_VERSION__
15#undef INSPECTION
16#endif
18#ifdef INSPECTION
19{-# LANGUAGE TemplateHaskell #-}
20{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
21#endif
23module Main
24 (
25 main
26 ) where
28import Control.DeepSeq (NFData(..))
29import Control.Monad (void, when)
30import Control.Monad.Catch (MonadCatch, try, SomeException)
31import Data.Functor.Identity (runIdentity)
32import Data.Maybe (isJust)
33import Data.Word (Word8)
34import Streamly.Internal.Data.Stream (Stream)
35import System.IO (Handle)
36import System.Random (randomRIO)
37import Prelude hiding ()
39import qualified Streamly.Internal.Data.Array as Array
40import qualified Streamly.Internal.Data.Stream.Chunked as ArrayStream
41import qualified Streamly.Internal.Data.Fold as Fold
42import qualified Streamly.Internal.Data.Parser as Parser
43import qualified Streamly.Internal.Data.Stream as S
44import qualified Streamly.Internal.Data.Stream.IsStream as Stream
45import qualified Streamly.Internal.FileSystem.Handle as Handle
46import qualified Streamly.Internal.Unicode.Stream as Unicode
48import Gauge hiding (env)
49import Streamly.Benchmark.Common
50import Streamly.Benchmark.Common.Handle
51import Control.Monad.IO.Class (MonadIO)
53#ifdef INSPECTION
54import Streamly.Internal.Data.Unboxed (Unbox)
55import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
56import Test.Inspection
57#endif
59-------------------------------------------------------------------------------
60-- Utilities
61-------------------------------------------------------------------------------
63-- XXX these can be moved to the common module
65{-# INLINE sourceUnfoldrM #-}
66sourceUnfoldrM :: MonadIO m => Int -> Int -> Stream m Int
67sourceUnfoldrM value n = S.unfoldrM step n
68 where
69 step cnt =
70 if cnt > n + value
71 then return Nothing
72 else return (Just (cnt, cnt + 1))
74{-# INLINE benchIO #-}
75benchIO
76 :: NFData b
77 => String -> (Int -> Stream IO a) -> (Stream IO a -> IO b) -> Benchmark
78benchIO name src sink =
79 bench name $ nfIO $ randomRIO (1,1) >>= sink . src
81-------------------------------------------------------------------------------
82-- read chunked using toChunks
83-------------------------------------------------------------------------------
85-- | Get the last byte from a file bytestream.
86toChunksLast :: Handle -> IO (Maybe Word8)
87toChunksLast inh = do
88 let s = Handle.readChunks inh
89 larr <- Stream.last s
90 return $ case larr of
91 Nothing -> Nothing
92 Just arr -> Array.getIndex (Array.length arr - 1) arr
94#ifdef INSPECTION
95inspect $ hasNoTypeClasses 'toChunksLast
96inspect $ 'toChunksLast `hasNoType` ''Step
97#endif
99-- | Count the number of bytes in a file.
100toChunksSumLengths :: Handle -> IO Int
101toChunksSumLengths inh =
102 let s = Handle.readChunks inh
103 in Stream.sum (Stream.map Array.length s)
105#ifdef INSPECTION
106inspect $ hasNoTypeClasses 'toChunksSumLengths
107inspect $ 'toChunksSumLengths `hasNoType` ''Step
108#endif
110-- | Sum the bytes in a file.
111toChunksCountBytes :: Handle -> IO Word8
112toChunksCountBytes inh = do
113 let foldlArr' f z = runIdentity . Stream.foldl' f z . Array.read
114 let s = Handle.readChunks inh
115 Stream.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
117#ifdef INSPECTION
118inspect $ hasNoTypeClasses 'toChunksCountBytes
119inspect $ 'toChunksCountBytes `hasNoType` ''Step
120#endif
122toChunksDecodeUtf8Arrays :: Handle -> IO ()
123toChunksDecodeUtf8Arrays =
124 Stream.drain . Unicode.decodeUtf8Arrays . Handle.readChunks
126#ifdef INSPECTION
127inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays
128-- inspect $ 'toChunksDecodeUtf8ArraysLenient `hasNoType` ''Step
129#endif
131-------------------------------------------------------------------------------
132-- Splitting
133-------------------------------------------------------------------------------
135-- | Count the number of lines in a file.
136toChunksSplitOnSuffix :: Handle -> IO Int
137toChunksSplitOnSuffix =
138 Stream.length . ArrayStream.splitOnSuffix 10 . Handle.readChunks
140#ifdef INSPECTION
141inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix
142inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step
143#endif
145-- XXX use a word splitting combinator instead of splitOn and test it.
146-- | Count the number of words in a file.
147toChunksSplitOn :: Handle -> IO Int
148toChunksSplitOn = Stream.length . ArrayStream.splitOn 32 . Handle.readChunks
150#ifdef INSPECTION
151inspect $ hasNoTypeClasses 'toChunksSplitOn
152inspect $ 'toChunksSplitOn `hasNoType` ''Step
153#endif
155o_1_space_read_chunked :: BenchEnv -> [Benchmark]
156o_1_space_read_chunked env =
157 -- read using toChunks instead of read
158 [ bgroup "reduce/toChunks"
159 [ mkBench "Stream.last" env $ \inH _ ->
160 toChunksLast inH
161 -- Note: this cannot be fairly compared with GNU wc -c or wc -m as
162 -- wc uses lseek to just determine the file size rather than reading
163 -- and counting characters.
164 , mkBench "Stream.sum . Stream.map Array.length" env $ \inH _ ->
165 toChunksSumLengths inH
166 , mkBench "splitOnSuffix" env $ \inH _ ->
167 toChunksSplitOnSuffix inH
168 , mkBench "splitOn" env $ \inH _ ->
169 toChunksSplitOn inH
170 , mkBench "countBytes" env $ \inH _ ->
171 toChunksCountBytes inH
172 , mkBenchSmall "decodeUtf8Arrays" env $ \inH _ ->
173 toChunksDecodeUtf8Arrays inH
174 ]
175 ]
177-------------------------------------------------------------------------------
178-- copy with group/ungroup transformations
179-------------------------------------------------------------------------------
181-- | Lines and unlines
182{-# NOINLINE copyChunksSplitInterposeSuffix #-}
183copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO ()
184copyChunksSplitInterposeSuffix inh outh =
185 Stream.fold (Handle.write outh)
186 $ ArrayStream.interposeSuffix 10
187 $ ArrayStream.splitOnSuffix 10
188 $ Handle.readChunks inh
190#ifdef INSPECTION
191inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Unbox]
192inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
193#endif
195-- | Words and unwords
196{-# NOINLINE copyChunksSplitInterpose #-}
197copyChunksSplitInterpose :: Handle -> Handle -> IO ()
198copyChunksSplitInterpose inh outh =
199 Stream.fold (Handle.write outh)
200 $ ArrayStream.interpose 32
201 -- XXX this is not correct word splitting combinator
202 $ ArrayStream.splitOn 32
203 $ Handle.readChunks inh
205#ifdef INSPECTION
206inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Unbox]
207inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step
208#endif
210o_1_space_copy_toChunks_group_ungroup :: BenchEnv -> [Benchmark]
211o_1_space_copy_toChunks_group_ungroup env =
212 [ bgroup "copy/toChunks/group-ungroup"
213 [ mkBench "interposeSuffix . splitOnSuffix" env $ \inh outh ->
214 copyChunksSplitInterposeSuffix inh outh
215 , mkBenchSmall "interpose . splitOn" env $ \inh outh ->
216 copyChunksSplitInterpose inh outh
217 ]
218 ]
220-------------------------------------------------------------------------------
221-- Parsers
222-------------------------------------------------------------------------------
224{-# INLINE drainWhile #-}
225drainWhile :: MonadCatch m => (a -> Bool) -> Parser.Parser a m ()
226drainWhile p = Parser.takeWhile p Fold.drain
228-------------------------------------------------------------------------------
229-- Folds and parsers
230-------------------------------------------------------------------------------
232{-# INLINE fold #-}
233fold :: Stream IO (Array.Array Int) -> IO ()
234fold s = void $ ArrayStream.foldBreak Fold.drain s
236{-# INLINE parse #-}
237parse :: Int -> Stream IO (Array.Array Int) -> IO ()
238parse value s = void $ ArrayStream.parseBreak (drainWhile (< value)) s
240{-# INLINE foldBreak #-}
241foldBreak :: Stream IO (Array.Array Int) -> IO ()
242foldBreak s = do
243 (r, s1) <- ArrayStream.foldBreak Fold.one s
244 when (isJust r) $ foldBreak s1
246{-# INLINE parseBreak #-}
247parseBreak :: Stream IO (Array.Array Int) -> IO ()
248parseBreak s = do
249 r <- try $ ArrayStream.parseBreak Parser.one s
250 case r of
251 Left (_ :: SomeException) -> return ()
252 Right (_, s1) -> parseBreak s1
254o_1_space_serial_array ::
255 Int -> [Array.Array Int] -> [Array.Array Int] -> [Benchmark]
256o_1_space_serial_array bound arraysSmall arraysBig =
257 [ benchIO "fold (of 100)" (\_ -> Stream.fromList arraysSmall) fold
258 , benchIO "fold (single)" (\_ -> Stream.fromList arraysBig) fold
259 , benchIO
260 "foldBreak (recursive, small arrays)"
261 (\_ -> Stream.fromList arraysSmall)
262 foldBreak
263 , benchIO "parse (of 100)" (\_ -> Stream.fromList arraysSmall)
264 $ parse bound
265 , benchIO "parse (single)" (\_ -> Stream.fromList arraysBig)
266 $ parse bound
267 , benchIO
268 "parseBreak (recursive, small arrays)"
269 (\_ -> Stream.fromList arraysSmall)
270 parseBreak
271 ]
273-------------------------------------------------------------------------------
274-- Driver
275-------------------------------------------------------------------------------
277moduleName :: String
278moduleName = "Data.Array.Stream"
280main :: IO ()
281main = do
282 env <- mkHandleBenchEnv
283 runWithCLIOptsEnv defaultStreamSize alloc (allBenchmarks env)
285 where
287 alloc value = do
288 small <- Stream.toList $ Stream.arraysOf 100 $ sourceUnfoldrM value 0
289 big <- Stream.toList $ Stream.arraysOf value $ sourceUnfoldrM value 0
290 return (small, big)
292 allBenchmarks env arrays value =
293 let (arraysSmall, arraysBig) = arrays
294 in [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
295 [ o_1_space_read_chunked env
296 , o_1_space_serial_array value arraysSmall arraysBig
297 , o_1_space_copy_toChunks_group_ungroup env
298 ]
299 ]