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