git.iko.soy/streamly
on 734d2cf help sign in
streamly/benchmark/Streamly/Benchmark/Data/Array/Mut.hs
301 lines 10.0 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 )
46import qualified Streamly.Internal.Data.Array as Array
47import qualified Streamly.Internal.Data.Array.Mut as MArray
48import qualified Streamly.Internal.Data.Fold as Fold
49import qualified Streamly.Internal.Data.Stream as Stream
50import qualified Streamly.Prelude as IsStream (scanl1')
52import Gauge
53import Streamly.Benchmark.Common hiding (benchPureSrc)
55type Stream = MArray.Array
57instance NFData (MArray.Array 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 $ IsStream.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 =
185 drain . Stream.fromStreamD . MArray.toStreamDRev
187{-# INLINE toStreamDDrain #-}
188toStreamDDrain :: MonadIO m => Stream Int -> m ()
189toStreamDDrain = drain . Stream.fromStreamD . MArray.toStreamD
191{-# INLINE unfoldFold #-}
192unfoldFold :: MonadIO m => Stream Int -> m Int
193unfoldFold = Stream.fold (Fold.foldl' (+) 0) . Stream.unfold MArray.reader
195-------------------------------------------------------------------------------
196-- Bench groups
197-------------------------------------------------------------------------------
199o_1_space_generation :: Int -> [Benchmark]
200o_1_space_generation value =
201 [ bgroup
202 "generation"
203 [ benchIOSrc "writeN . intFromTo" (sourceIntFromTo value)
204 , benchIOSrc
205 "fromList . intFromTo"
206 (sourceIntFromToFromList value)
207 , benchIOSrc "writeN . unfoldr" (sourceUnfoldr value)
208 , benchIOSrc "writeN . fromList" (sourceFromList value)
209 , benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)
210 ]
211 ]
213o_1_space_elimination :: Int -> [Benchmark]
214o_1_space_elimination value =
215 [ bgroup "elimination"
216 [ benchPureSink value "id" id
217 , benchIOSink value "foldl'" unfoldFold
218 , benchIOSink value "read" unfoldReadDrain
219 , benchIOSink value "readRev" unfoldReadRevDrain
220 , benchIOSink value "toStream" toStreamDDrain
221 , benchIOSink value "toStreamRev" toStreamDRevDrain
222 ]
223 ]
225o_n_heap_serial :: Int -> [Benchmark]
226o_n_heap_serial value =
227 [ bgroup "elimination"
228 [
229 -- Converting the stream to an array
230 benchFold "writeN" (Stream.fold (MArray.writeN value))
231 (sourceUnfoldrM value)
232 ]
233 ]
235o_1_space_transformation :: Int -> [Benchmark]
236o_1_space_transformation value =
237 [ bgroup "transformation"
238 [ benchIOSink value "scanl'" (scanl' value 1)
239 , benchIOSink value "scanl1'" (scanl1' value 1)
240 , benchIOSink value "map" (map value 1)
241 ]
242 ]
244o_1_space_transformationX4 :: Int -> [Benchmark]
245o_1_space_transformationX4 value =
246 [ bgroup "transformationX4"
247 [ benchIOSink value "scanl'" (scanl' value 4)
248 , benchIOSink value "scanl1'" (scanl1' value 4)
249 , benchIOSink value "map" (map value 4)
250 ]
251 ]
253o_1_space_serial_marray ::
254 Int -> (MArray.Array Int, Array.Array Int) -> [Benchmark]
255o_1_space_serial_marray value ~(array, indices) =
256 [ benchIO' "partitionBy (< 0)" (const (return array))
257 $ MArray.partitionBy (< 0)
258 , benchIO' "partitionBy (> 0)" (const (return array))
259 $ MArray.partitionBy (> 0)
260 , benchIO' "partitionBy (< value/2)" (const (return array))
261 $ MArray.partitionBy (< (value `div` 2))
262 , benchIO' "partitionBy (> value/2)" (const (return array))
263 $ MArray.partitionBy (> (value `div` 2))
264 , benchIO' "strip (< value/2 || > value/2)" (const (return array))
265 $ MArray.strip (\x -> x < value `div` 2 || x > value `div` 2)
266 , benchIO' "strip (> 0)" (const (return array))
267 $ MArray.strip (> 0)
268 , benchIO' "modifyIndices (+ 1)" (const (return indices))
269 $ Stream.fold (MArray.modifyIndices array (\_idx val -> val + 1))
270 . Stream.unfold Array.reader
271 ]
273-------------------------------------------------------------------------------
274-- Driver
275-------------------------------------------------------------------------------
277moduleName :: String
278moduleName = "Data.Array.Mut"
280main :: IO ()
281main = do
282 runWithCLIOptsEnv defaultStreamSize alloc allBenchmarks
284 where
286 alloc value = do
287 marr <- MArray.fromStream (sourceUnfoldrM value 0 :: Stream.Stream IO Int)
288 indices <- Array.fromStream (sourceUnfoldrM value 0 :: Stream.Stream IO Int)
289 return (marr, indices)
291 allBenchmarks array value =
292 [ bgroup (o_1_space_prefix moduleName)
293 $ concat
294 [ o_1_space_serial_marray value array
295 , o_1_space_generation value
296 , o_1_space_elimination value
297 , o_1_space_transformation value
298 , o_1_space_transformationX4 value
299 ]
300 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
301 ]