git.iko.soy/streamly
on dc58c59 help sign in
streamly/benchmark/Streamly/Benchmark/Data/Array/Stream.hs
309 lines 10 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)
31import Data.Functor.Identity (runIdentity)
32import Data.Maybe (isJust)
33import Data.Word (Word8)
34import Streamly.Internal.Data.Stream (Stream)
35import Streamly.Internal.Data.StreamK (StreamK)
36import System.IO (Handle)
37import System.Random (randomRIO)
38import Prelude hiding ()
40import qualified Streamly.Data.Stream as Stream
41import qualified Streamly.Internal.Data.Array as Array
42import qualified Streamly.Internal.Data.Array.Stream as ArrayStream
43import qualified Streamly.Internal.Data.Fold as Fold
44import qualified Streamly.Internal.Data.Parser as Parser
45import qualified Streamly.Internal.Data.Stream as Stream
46import qualified Streamly.Internal.Data.StreamK as StreamK
47import qualified Streamly.Internal.FileSystem.Handle as Handle
48import qualified Streamly.Internal.Unicode.Stream as Unicode
50import Test.Tasty.Bench hiding (env)
51import Streamly.Benchmark.Common
52import Streamly.Benchmark.Common.Handle
53import Control.Monad.IO.Class (MonadIO)
55#ifdef INSPECTION
56import Streamly.Internal.Data.Serialize (Unbox)
57import Streamly.Internal.Data.Stream (Step(..))
58import Test.Inspection
59#endif
61-------------------------------------------------------------------------------
62-- Utilities
63-------------------------------------------------------------------------------
65-- XXX these can be moved to the common module
67{-# INLINE sourceUnfoldrM #-}
68sourceUnfoldrM :: MonadIO m => Int -> Int -> Stream.Stream m Int
69sourceUnfoldrM value n = Stream.unfoldrM step n
70 where
71 step cnt =
72 if cnt > n + value
73 then return Nothing
74 else return (Just (cnt, cnt + 1))
76{-# INLINE benchIO #-}
77benchIO
78 :: NFData b
79 => String -> (Int -> Stream IO a) -> (Stream IO a -> IO b) -> Benchmark
80benchIO name src sink =
81 bench name $ nfIO $ randomRIO (1,1) >>= sink . src
83-------------------------------------------------------------------------------
84-- read chunked using toChunks
85-------------------------------------------------------------------------------
87-- | Get the last byte from a file bytestream.
88toChunksLast :: Handle -> IO (Maybe Word8)
89toChunksLast inh = do
90 let s = Handle.readChunks inh
91 larr <- Stream.last s
92 return $ case larr of
93 Nothing -> Nothing
94 Just arr -> Array.getIndex (Array.length arr - 1) arr
96#ifdef INSPECTION
97inspect $ hasNoTypeClasses 'toChunksLast
98inspect $ 'toChunksLast `hasNoType` ''Step
99#endif
101-- | Count the number of bytes in a file.
102toChunksSumLengths :: Handle -> IO Int
103toChunksSumLengths inh =
104 let s = Handle.readChunks inh
105 in Stream.fold Fold.sum (Stream.map Array.length s)
107#ifdef INSPECTION
108inspect $ hasNoTypeClasses 'toChunksSumLengths
109inspect $ 'toChunksSumLengths `hasNoType` ''Step
110#endif
112-- | Sum the bytes in a file.
113toChunksCountBytes :: Handle -> IO Word8
114toChunksCountBytes inh = do
115 let foldlArr' f z = runIdentity . Stream.foldl' f z . Array.read
116 let s = Handle.readChunks inh
117 Stream.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
119#ifdef INSPECTION
120inspect $ hasNoTypeClasses 'toChunksCountBytes
121inspect $ 'toChunksCountBytes `hasNoType` ''Step
122#endif
124toChunksDecodeUtf8Arrays :: Handle -> IO ()
125toChunksDecodeUtf8Arrays =
126 Stream.drain . Unicode.decodeUtf8Chunks . Handle.readChunks
128#ifdef INSPECTION
129inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays
130-- inspect $ 'toChunksDecodeUtf8ArraysLenient `hasNoType` ''Step
131#endif
133-------------------------------------------------------------------------------
134-- Splitting
135-------------------------------------------------------------------------------
137-- | Count the number of lines in a file.
138toChunksSplitOnSuffix :: Handle -> IO Int
139toChunksSplitOnSuffix =
140 Stream.fold Fold.length
141 . ArrayStream.splitOnSuffix 10
142 . Handle.readChunks
144#ifdef INSPECTION
145inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix
146inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step
147#endif
149-- XXX use a word splitting combinator instead of splitOn and test it.
150-- | Count the number of words in a file.
151toChunksSplitOn :: Handle -> IO Int
152toChunksSplitOn =
153 Stream.fold Fold.length
154 . ArrayStream.splitOn 32
155 . Handle.readChunks
157#ifdef INSPECTION
158inspect $ hasNoTypeClasses 'toChunksSplitOn
159inspect $ 'toChunksSplitOn `hasNoType` ''Step
160#endif
162o_1_space_read_chunked :: BenchEnv -> [Benchmark]
163o_1_space_read_chunked env =
164 -- read using toChunks instead of read
165 [ bgroup "reduce/toChunks"
166 [ mkBench "Stream.last" env $ \inH _ ->
167 toChunksLast inH
168 -- Note: this cannot be fairly compared with GNU wc -c or wc -m as
169 -- wc uses lseek to just determine the file size rather than reading
170 -- and counting characters.
171 , mkBench "Stream.sum . Stream.map Array.length" env $ \inH _ ->
172 toChunksSumLengths inH
173 , mkBench "splitOnSuffix" env $ \inH _ ->
174 toChunksSplitOnSuffix inH
175 , mkBench "splitOn" env $ \inH _ ->
176 toChunksSplitOn inH
177 , mkBench "countBytes" env $ \inH _ ->
178 toChunksCountBytes inH
179 , mkBenchSmall "decodeUtf8Arrays" env $ \inH _ ->
180 toChunksDecodeUtf8Arrays inH
181 ]
182 ]
184-------------------------------------------------------------------------------
185-- copy with group/ungroup transformations
186-------------------------------------------------------------------------------
188-- | Lines and unlines
189{-# NOINLINE copyChunksSplitInterposeSuffix #-}
190copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO ()
191copyChunksSplitInterposeSuffix inh outh =
192 Stream.fold (Handle.write outh)
193 $ ArrayStream.interposeSuffix 10 . ArrayStream.splitOnSuffix 10
194 $ Handle.readChunks inh
196#ifdef INSPECTION
197inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Unbox]
198inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
199#endif
201-- | Words and unwords
202{-# NOINLINE copyChunksSplitInterpose #-}
203copyChunksSplitInterpose :: Handle -> Handle -> IO ()
204copyChunksSplitInterpose inh outh =
205 Stream.fold (Handle.write outh)
206 -- XXX this is not correct word splitting combinator
207 $ ArrayStream.interpose 32 . ArrayStream.splitOn 32
208 $ Handle.readChunks inh
210#ifdef INSPECTION
211inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Unbox]
212inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step
213#endif
215o_1_space_copy_toChunks_group_ungroup :: BenchEnv -> [Benchmark]
216o_1_space_copy_toChunks_group_ungroup env =
217 [ bgroup "copy/toChunks/group-ungroup"
218 [ mkBench "interposeSuffix . splitOnSuffix" env $ \inh outh ->
219 copyChunksSplitInterposeSuffix inh outh
220 , mkBenchSmall "interpose . splitOn" env $ \inh outh ->
221 copyChunksSplitInterpose inh outh
222 ]
223 ]
225-------------------------------------------------------------------------------
226-- Parsers
227-------------------------------------------------------------------------------
229{-# INLINE drainWhile #-}
230drainWhile :: MonadCatch m => (a -> Bool) -> Parser.Parser a m ()
231drainWhile p = Parser.takeWhile p Fold.drain
233-------------------------------------------------------------------------------
234-- Folds and parsers
235-------------------------------------------------------------------------------
237{-# INLINE fold #-}
238fold :: Stream IO (Array.Array Int) -> IO ()
239fold s = void $ ArrayStream.foldBreak Fold.drain $ StreamK.fromStream s
241{-# INLINE parse #-}
242parse :: Int -> Stream IO (Array.Array Int) -> IO ()
243parse value s =
244 void $ ArrayStream.parseBreak (drainWhile (< value)) $ StreamK.fromStream s
246{-# INLINE foldBreak #-}
247foldBreak :: StreamK IO (Array.Array Int) -> IO ()
248foldBreak s = do
249 (r, s1) <- ArrayStream.foldBreak Fold.one s
250 when (isJust r) $ foldBreak s1
252{-# INLINE parseBreak #-}
253parseBreak :: StreamK IO (Array.Array Int) -> IO ()
254parseBreak s = do
255 r <- ArrayStream.parseBreak Parser.one s
256 case r of
257 (Left _, _) -> return ()
258 (Right _, s1) -> parseBreak s1
260o_1_space_serial_array ::
261 Int -> [Array.Array Int] -> [Array.Array Int] -> [Benchmark]
262o_1_space_serial_array bound arraysSmall arraysBig =
263 [ benchIO "fold (of 100)" (\_ -> Stream.fromList arraysSmall) fold
264 , benchIO "fold (single)" (\_ -> Stream.fromList arraysBig) fold
265 , benchIO
266 "foldBreak (recursive, small arrays)"
267 (\_ -> Stream.fromList arraysSmall)
268 (foldBreak . StreamK.fromStream)
269 , benchIO "parse (of 100)" (\_ -> Stream.fromList arraysSmall)
270 $ parse bound
271 , benchIO "parse (single)" (\_ -> Stream.fromList arraysBig)
272 $ parse bound
273 , benchIO
274 "parseBreak (recursive, small arrays)"
275 (\_ -> Stream.fromList arraysSmall)
276 (parseBreak . StreamK.fromStream)
277 ]
279-------------------------------------------------------------------------------
280-- Driver
281-------------------------------------------------------------------------------
283moduleName :: String
284moduleName = "Data.Array.Stream"
286main :: IO ()
287main = do
288 env <- mkHandleBenchEnv
289 runWithCLIOptsEnv defaultStreamSize alloc (allBenchmarks env)
291 where
293 alloc value =
294 if value <= 0
295 then return (undefined, undefined)
296 else
297 do
298 small <- Stream.toList $ Stream.chunksOf 100 $ sourceUnfoldrM value 0
299 big <- Stream.toList $ Stream.chunksOf value $ sourceUnfoldrM value 0
300 return (small, big)
302 allBenchmarks env arrays value =
303 let (arraysSmall, arraysBig) = arrays
304 in [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
305 [ o_1_space_read_chunked env
306 , o_1_space_serial_array value arraysSmall arraysBig
307 , o_1_space_copy_toChunks_group_ungroup env
308 ]
309 ]