git.iko.soy/streamly
on dc58c59 help sign in
streamly/benchmark/Streamly/Benchmark/Data/MutArray.hs
300 lines 9.9 kB history raw
1{-# OPTIONS_GHC -Wno-deprecations #-}
2{-# OPTIONS_GHC -Wno-orphans #-}
4-- |
5-- Module : Streamly.Benchmark.Data.Array.Unboxed.Mut
6-- Copyright : (c) 2021 Composewell Technologies
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
23import Control.DeepSeq (NFData(..))
24import Control.Monad.IO.Class (MonadIO)
25import Data.Functor ((<&>))
26import System.Random (randomRIO)
27import Prelude
28 ( IO
29 , Int
30 , Integral(..)
31 , Maybe(..)
32 , Monad(..)
33 , Num(..)
34 , Ord(..)
35 , String
36 , ($)
37 , (.)
38 , (||)
39 , concat
40 , const
41 , fmap
42 , id
43 , undefined
44 )
45import Streamly.Internal.Data.MutArray (MutArray)
47import qualified Streamly.Internal.Data.Array as Array
48import qualified Streamly.Internal.Data.MutArray as MArray
49import qualified Streamly.Internal.Data.Fold as Fold
50import qualified Streamly.Internal.Data.Stream as Stream
52import Test.Tasty.Bench
53import Streamly.Benchmark.Common hiding (benchPureSrc)
55type Stream = MutArray
57instance NFData (MutArray a) where
58 {-# INLINE rnf #-}
59 rnf _ = ()
61-------------------------------------------------------------------------------
62-- Benchmark helpers
63-------------------------------------------------------------------------------
65{-# INLINE benchIO #-}
66benchIO :: NFData b => String -> (Int -> IO a) -> (a -> b) -> Benchmark
67benchIO name src f = bench name $ nfIO $
68 (randomRIO (1,1) >>= src) <&> f
70{-# INLINE benchPureSink #-}
71benchPureSink :: NFData b => Int -> String -> (Stream Int -> b) -> Benchmark
72benchPureSink value name = benchIO name (sourceIntFromTo value)
74{-# INLINE benchIO' #-}
75benchIO' :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark
76benchIO' name src f = bench name $ nfIO $
77 randomRIO (1,1) >>= src >>= f
79{-# INLINE benchIOSink #-}
80benchIOSink :: NFData b => Int -> String -> (Stream Int -> IO b) -> Benchmark
81benchIOSink value name = benchIO' name (sourceIntFromTo value)
83-- Drain a source that generates an array in the IO monad
84{-# INLINE benchIOSrc #-}
85benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark
86benchIOSrc name src = benchIO name src id
88drain :: Monad m => Stream.Stream m a -> m ()
89drain = Stream.fold Fold.drain
91-------------------------------------------------------------------------------
92-- Bench Ops
93-------------------------------------------------------------------------------
95{-# INLINE sourceUnfoldr #-}
96sourceUnfoldr :: MonadIO m => Int -> Int -> m (Stream Int)
97sourceUnfoldr value n =
98 Stream.fold (MArray.writeN value) $ Stream.unfoldr step n
100 where
102 step cnt =
103 if cnt > n + value
104 then Nothing
105 else Just (cnt, cnt + 1)
107{-# INLINE sourceIntFromTo #-}
108sourceIntFromTo :: MonadIO m => Int -> Int -> m (Stream Int)
109sourceIntFromTo value n =
110 Stream.fold (MArray.writeN value) $ Stream.enumerateFromTo n (n + value)
112{-# INLINE sourceFromList #-}
113sourceFromList :: MonadIO m => Int -> Int -> m (Stream Int)
114sourceFromList value n =
115 Stream.fold (MArray.writeN value) $ Stream.fromList [n .. n + value]
117{-# INLINE sourceIntFromToFromList #-}
118sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)
119sourceIntFromToFromList value n = MArray.fromListN value [n..n + value]
121{-# INLINE sourceIntFromToFromStream #-}
122sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)
123sourceIntFromToFromStream value n =
124 Stream.fold MArray.write $ Stream.enumerateFromTo n (n + value)
126{-# INLINE sourceUnfoldrM #-}
127sourceUnfoldrM :: Monad m => Int -> Int -> Stream.Stream m Int
128sourceUnfoldrM value n = Stream.unfoldrM step n
129 where
130 step cnt =
131 if cnt > n + value
132 then return Nothing
133 else return (Just (cnt, cnt + 1))
135-------------------------------------------------------------------------------
136-- Transformation
137-------------------------------------------------------------------------------
139{-# INLINE composeN #-}
140composeN :: Monad m
141 => Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int)
142composeN n f x =
143 case n of
144 1 -> f x
145 2 -> f x >>= f
146 3 -> f x >>= f >>= f
147 4 -> f x >>= f >>= f >>= f
148 _ -> undefined
150{-# INLINE scanl' #-}
151scanl' :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)
152scanl' value n = composeN n $ onArray value $ Stream.scan (Fold.foldl' (+) 0)
154{-# INLINE scanl1' #-}
155scanl1' :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)
156scanl1' value n = composeN n $ onArray value $ Stream.scanl1' (+)
158{-# INLINE map #-}
159map :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)
160map value n = composeN n $ onArray value $ fmap (+ 1)
162{-# INLINE onArray #-}
163onArray
164 :: MonadIO m => Int -> (Stream.Stream m Int -> Stream.Stream m Int)
165 -> Stream Int
166 -> m (Stream Int)
167onArray value f arr =
168 Stream.fold (MArray.writeN value) $ f $ Stream.unfold MArray.reader arr
170-------------------------------------------------------------------------------
171-- Elimination
172-------------------------------------------------------------------------------
174{-# INLINE unfoldReadDrain #-}
175unfoldReadDrain :: MonadIO m => Stream Int -> m ()
176unfoldReadDrain = drain . Stream.unfold MArray.reader
178{-# INLINE unfoldReadRevDrain #-}
179unfoldReadRevDrain :: MonadIO m => Stream Int -> m ()
180unfoldReadRevDrain = drain . Stream.unfold MArray.readerRev
182{-# INLINE toStreamDRevDrain #-}
183toStreamDRevDrain :: MonadIO m => Stream Int -> m ()
184toStreamDRevDrain = drain . MArray.readRev
186{-# INLINE toStreamDDrain #-}
187toStreamDDrain :: MonadIO m => Stream Int -> m ()
188toStreamDDrain = drain . MArray.read
190{-# INLINE unfoldFold #-}
191unfoldFold :: MonadIO m => Stream Int -> m Int
192unfoldFold = Stream.fold (Fold.foldl' (+) 0) . Stream.unfold MArray.reader
194-------------------------------------------------------------------------------
195-- Bench groups
196-------------------------------------------------------------------------------
198o_1_space_generation :: Int -> [Benchmark]
199o_1_space_generation value =
200 [ bgroup
201 "generation"
202 [ benchIOSrc "writeN . intFromTo" (sourceIntFromTo value)
203 , benchIOSrc
204 "fromList . intFromTo"
205 (sourceIntFromToFromList value)
206 , benchIOSrc "writeN . unfoldr" (sourceUnfoldr value)
207 , benchIOSrc "writeN . fromList" (sourceFromList value)
208 , benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)
209 ]
210 ]
212o_1_space_elimination :: Int -> [Benchmark]
213o_1_space_elimination value =
214 [ bgroup "elimination"
215 [ benchPureSink value "id" id
216 , benchIOSink value "foldl'" unfoldFold
217 , benchIOSink value "read" unfoldReadDrain
218 , benchIOSink value "readRev" unfoldReadRevDrain
219 , benchIOSink value "toStream" toStreamDDrain
220 , benchIOSink value "toStreamRev" toStreamDRevDrain
221 ]
222 ]
224o_n_heap_serial :: Int -> [Benchmark]
225o_n_heap_serial value =
226 [ bgroup "elimination"
227 [
228 -- Converting the stream to an array
229 benchFold "writeN" (Stream.fold (MArray.writeN value))
230 (sourceUnfoldrM value)
231 ]
232 ]
234o_1_space_transformation :: Int -> [Benchmark]
235o_1_space_transformation value =
236 [ bgroup "transformation"
237 [ benchIOSink value "scanl'" (scanl' value 1)
238 , benchIOSink value "scanl1'" (scanl1' value 1)
239 , benchIOSink value "map" (map value 1)
240 ]
241 ]
243o_1_space_transformationX4 :: Int -> [Benchmark]
244o_1_space_transformationX4 value =
245 [ bgroup "transformationX4"
246 [ benchIOSink value "scanl'" (scanl' value 4)
247 , benchIOSink value "scanl1'" (scanl1' value 4)
248 , benchIOSink value "map" (map value 4)
249 ]
250 ]
252o_1_space_serial_marray ::
253 Int -> (MutArray Int, Array.Array Int) -> [Benchmark]
254o_1_space_serial_marray value ~(array, indices) =
255 [ benchIO' "partitionBy (< 0)" (const (return array))
256 $ MArray.partitionBy (< 0)
257 , benchIO' "partitionBy (> 0)" (const (return array))
258 $ MArray.partitionBy (> 0)
259 , benchIO' "partitionBy (< value/2)" (const (return array))
260 $ MArray.partitionBy (< (value `div` 2))
261 , benchIO' "partitionBy (> value/2)" (const (return array))
262 $ MArray.partitionBy (> (value `div` 2))
263 , benchIO' "strip (< value/2 || > value/2)" (const (return array))
264 $ MArray.strip (\x -> x < value `div` 2 || x > value `div` 2)
265 , benchIO' "strip (> 0)" (const (return array))
266 $ MArray.strip (> 0)
267 , benchIO' "modifyIndices (+ 1)" (const (return indices))
268 $ Stream.fold (MArray.modifyIndices array (\_idx val -> val + 1))
269 . Stream.unfold Array.reader
270 ]
272-------------------------------------------------------------------------------
273-- Driver
274-------------------------------------------------------------------------------
276moduleName :: String
277moduleName = "Data.MutArray"
279main :: IO ()
280main = do
281 runWithCLIOptsEnv defaultStreamSize alloc allBenchmarks
283 where
285 alloc value = do
286 marr <- MArray.fromStream (sourceUnfoldrM value 0 :: Stream.Stream IO Int)
287 indices <- Array.fromStream (sourceUnfoldrM value 0 :: Stream.Stream IO Int)
288 return (marr, indices)
290 allBenchmarks array value =
291 [ bgroup (o_1_space_prefix moduleName)
292 $ concat
293 [ o_1_space_serial_marray value array
294 , o_1_space_generation value
295 , o_1_space_elimination value
296 , o_1_space_transformation value
297 , o_1_space_transformationX4 value
298 ]
299 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
300 ]