git.iko.soy/streamly
on a05abfc help sign in
streamly/benchmark/Streamly/Benchmark/Data/Array/Stream/Foreign.hs
273 lines 9.2 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)
28import Control.Monad.Catch (MonadThrow)
29import Data.Functor.Identity (runIdentity)
30import Data.Word (Word8)
31import System.IO (Handle)
32import System.Random (randomRIO)
33import Prelude hiding ()
35import qualified Streamly.Prelude as Stream
36import qualified Streamly.Internal.Data.Array.Foreign as Array
37import qualified Streamly.Internal.Data.Array.Stream.Foreign as ArrayStream
38import qualified Streamly.Internal.Data.Fold as Fold
39import qualified Streamly.Internal.Data.Parser.ParserD as ParserD
40import qualified Streamly.Internal.Data.Stream.IsStream as Stream (arraysOf)
41import qualified Streamly.Internal.FileSystem.Handle as Handle
42import qualified Streamly.Internal.Unicode.Stream as Unicode
44import Gauge hiding (env)
45import Streamly.Prelude (SerialT, MonadAsync, IsStream)
46import Streamly.Benchmark.Common
47import Streamly.Benchmark.Common.Handle
49#ifdef INSPECTION
50import Foreign.Storable (Storable)
51import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
52import Test.Inspection
53#endif
55-------------------------------------------------------------------------------
56-- Utilities
57-------------------------------------------------------------------------------
59-- XXX these can be moved to the common module
61{-# INLINE sourceUnfoldrM #-}
62sourceUnfoldrM :: (IsStream t, MonadAsync m) => Int -> Int -> t m Int
63sourceUnfoldrM value n = Stream.unfoldrM step n
64 where
65 step cnt =
66 if cnt > n + value
67 then return Nothing
68 else return (Just (cnt, cnt + 1))
70{-# INLINE benchIO #-}
71benchIO
72 :: NFData b
73 => String -> (Int -> t IO a) -> (t IO a -> IO b) -> Benchmark
74benchIO name src sink =
75 bench name $ nfIO $ randomRIO (1,1) >>= sink . src
77-------------------------------------------------------------------------------
78-- read chunked using toChunks
79-------------------------------------------------------------------------------
81-- | Get the last byte from a file bytestream.
82toChunksLast :: Handle -> IO (Maybe Word8)
83toChunksLast inh = do
84 let s = Handle.toChunks inh
85 larr <- Stream.last s
86 return $ case larr of
87 Nothing -> Nothing
88 Just arr -> Array.getIndex arr (Array.length arr - 1)
90#ifdef INSPECTION
91inspect $ hasNoTypeClasses 'toChunksLast
92inspect $ 'toChunksLast `hasNoType` ''Step
93#endif
95-- | Count the number of bytes in a file.
96toChunksSumLengths :: Handle -> IO Int
97toChunksSumLengths inh =
98 let s = Handle.toChunks inh
99 in Stream.sum (Stream.map Array.length s)
101#ifdef INSPECTION
102inspect $ hasNoTypeClasses 'toChunksSumLengths
103inspect $ 'toChunksSumLengths `hasNoType` ''Step
104#endif
106-- | Sum the bytes in a file.
107toChunksCountBytes :: Handle -> IO Word8
108toChunksCountBytes inh = do
109 let foldlArr' f z = runIdentity . Stream.foldl' f z . Array.toStream
110 let s = Handle.toChunks inh
111 Stream.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
113#ifdef INSPECTION
114inspect $ hasNoTypeClasses 'toChunksCountBytes
115inspect $ 'toChunksCountBytes `hasNoType` ''Step
116#endif
118toChunksDecodeUtf8Arrays :: Handle -> IO ()
119toChunksDecodeUtf8Arrays =
120 Stream.drain . Unicode.decodeUtf8Arrays . Handle.toChunks
122#ifdef INSPECTION
123inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays
124-- inspect $ 'toChunksDecodeUtf8ArraysLenient `hasNoType` ''Step
125#endif
127-------------------------------------------------------------------------------
128-- Splitting
129-------------------------------------------------------------------------------
131-- | Count the number of lines in a file.
132toChunksSplitOnSuffix :: Handle -> IO Int
133toChunksSplitOnSuffix =
134 Stream.length . ArrayStream.splitOnSuffix 10 . Handle.toChunks
136#ifdef INSPECTION
137inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix
138inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step
139#endif
141-- XXX use a word splitting combinator instead of splitOn and test it.
142-- | Count the number of words in a file.
143toChunksSplitOn :: Handle -> IO Int
144toChunksSplitOn = Stream.length . ArrayStream.splitOn 32 . Handle.toChunks
146#ifdef INSPECTION
147inspect $ hasNoTypeClasses 'toChunksSplitOn
148inspect $ 'toChunksSplitOn `hasNoType` ''Step
149#endif
151o_1_space_read_chunked :: BenchEnv -> [Benchmark]
152o_1_space_read_chunked env =
153 -- read using toChunks instead of read
154 [ bgroup "reduce/toChunks"
155 [ mkBench "Stream.last" env $ \inH _ ->
156 toChunksLast inH
157 -- Note: this cannot be fairly compared with GNU wc -c or wc -m as
158 -- wc uses lseek to just determine the file size rather than reading
159 -- and counting characters.
160 , mkBench "Stream.sum . Stream.map Array.length" env $ \inH _ ->
161 toChunksSumLengths inH
162 , mkBench "splitOnSuffix" env $ \inH _ ->
163 toChunksSplitOnSuffix inH
164 , mkBench "splitOn" env $ \inH _ ->
165 toChunksSplitOn inH
166 , mkBench "countBytes" env $ \inH _ ->
167 toChunksCountBytes inH
168 , mkBenchSmall "decodeUtf8Arrays" env $ \inH _ ->
169 toChunksDecodeUtf8Arrays inH
170 ]
171 ]
173-------------------------------------------------------------------------------
174-- copy with group/ungroup transformations
175-------------------------------------------------------------------------------
177-- | Lines and unlines
178{-# NOINLINE copyChunksSplitInterposeSuffix #-}
179copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO ()
180copyChunksSplitInterposeSuffix inh outh =
181 Stream.fold (Handle.write outh)
182 $ ArrayStream.interposeSuffix 10
183 $ ArrayStream.splitOnSuffix 10
184 $ Handle.toChunks inh
186#ifdef INSPECTION
187inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Storable]
188inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
189#endif
191-- | Words and unwords
192{-# NOINLINE copyChunksSplitInterpose #-}
193copyChunksSplitInterpose :: Handle -> Handle -> IO ()
194copyChunksSplitInterpose inh outh =
195 Stream.fold (Handle.write outh)
196 $ ArrayStream.interpose 32
197 -- XXX this is not correct word splitting combinator
198 $ ArrayStream.splitOn 32
199 $ Handle.toChunks inh
201#ifdef INSPECTION
202inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Storable]
203inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step
204#endif
206o_1_space_copy_toChunks_group_ungroup :: BenchEnv -> [Benchmark]
207o_1_space_copy_toChunks_group_ungroup env =
208 [ bgroup "copy/toChunks/group-ungroup"
209 [ mkBench "interposeSuffix . splitOnSuffix" env $ \inh outh ->
210 copyChunksSplitInterposeSuffix inh outh
211 , mkBenchSmall "interpose . splitOn" env $ \inh outh ->
212 copyChunksSplitInterpose inh outh
213 ]
214 ]
216-------------------------------------------------------------------------------
217-- Parsers
218-------------------------------------------------------------------------------
220{-# INLINE drainWhile #-}
221drainWhile :: MonadThrow m => (a -> Bool) -> ParserD.Parser m a ()
222drainWhile p = ParserD.takeWhile p Fold.drain
224-------------------------------------------------------------------------------
225-- Folds and parsers
226-------------------------------------------------------------------------------
228{-# INLINE fold #-}
229fold :: SerialT IO (Array.Array Int) -> IO ()
230fold s = void $ ArrayStream.fold Fold.drain s
232{-# INLINE parseArray #-}
233parseArray :: Int -> SerialT IO (Array.Array Int) -> IO ()
234parseArray value s = void $ ArrayStream.parse (drainWhile (< value)) s
236o_1_space_serial_array ::
237 Int -> [Array.Array Int] -> [Array.Array Int] -> [Benchmark]
238o_1_space_serial_array bound arraysSmall arraysBig =
239 [ benchIO "fold (of 100)" (\_ -> Stream.fromList arraysSmall) fold
240 , benchIO "fold (single)" (\_ -> Stream.fromList arraysBig) fold
241 , benchIO "parse (of 100)" (\_ -> Stream.fromList arraysSmall)
242 $ parseArray bound
243 , benchIO "parse (single)" (\_ -> Stream.fromList arraysBig)
244 $ parseArray bound
245 ]
247-------------------------------------------------------------------------------
248-- Driver
249-------------------------------------------------------------------------------
251moduleName :: String
252moduleName = "Data.Array.Stream.Foreign"
254main :: IO ()
255main = do
256 env <- mkHandleBenchEnv
257 runWithCLIOptsEnv defaultStreamSize alloc (allBenchmarks env)
259 where
261 alloc value = do
262 small <- Stream.toList $ Stream.arraysOf 100 $ sourceUnfoldrM value 0
263 big <- Stream.toList $ Stream.arraysOf value $ sourceUnfoldrM value 0
264 return (small, big)
266 allBenchmarks env arrays value =
267 let (arraysSmall, arraysBig) = arrays
268 in [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
269 [ o_1_space_read_chunked env
270 , o_1_space_serial_array value arraysSmall arraysBig
271 , o_1_space_copy_toChunks_group_ungroup env
272 ]
273 ]