mirror of
https://github.com/composewell/streamly.git
synced 2024-08-16 15:00:25 +03:00
Improve mutable foreign array benchmarks
This commit is contained in:
Adithya Kumar
parent
c2acb453e7
commit
0d5a96eacc
@ -17,23 +17,102 @@
|
||||
{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
|
||||
#endif
|
||||
|
||||
module Main (main) where
|
||||
|
||||
import Control.DeepSeq (NFData(..))
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import Data.Functor ((<&>))
|
||||
import Streamly.Prelude (MonadAsync, SerialT, IsStream)
|
||||
import Streamly.Internal.Data.Stream.Serial (SerialT(..))
|
||||
import System.Random (randomRIO)
|
||||
import Prelude
|
||||
( IO
|
||||
, Int
|
||||
, Integral(..)
|
||||
, Maybe(..)
|
||||
, Monad(..)
|
||||
, Num(..)
|
||||
, Ord(..)
|
||||
, String
|
||||
, ($)
|
||||
, (.)
|
||||
, (||)
|
||||
, concat
|
||||
, const
|
||||
, id
|
||||
, undefined
|
||||
)
|
||||
|
||||
import qualified Streamly.Prelude as Stream
|
||||
import qualified Streamly.Internal.Data.Array.Foreign as Array
|
||||
import qualified Streamly.Internal.Data.Array.Foreign.Mut as MArray
|
||||
import qualified Streamly.Internal.Data.Stream.StreamD as StreamD
|
||||
import qualified Streamly.Prelude as Stream
|
||||
|
||||
import Gauge hiding (env)
|
||||
import Streamly.Benchmark.Common
|
||||
import Gauge
|
||||
import Streamly.Benchmark.Common hiding (benchPureSrc)
|
||||
|
||||
type Stream = MArray.Array
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Utilities
|
||||
-- Benchmark helpers
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
{-# INLINE benchIO #-}
|
||||
benchIO :: NFData b => String -> (Int -> IO a) -> (a -> b) -> Benchmark
|
||||
benchIO name src f = bench name $ nfIO $
|
||||
(randomRIO (1,1) >>= src) <&> f
|
||||
|
||||
{-# INLINE benchPureSink #-}
|
||||
benchPureSink :: NFData b => Int -> String -> (Stream Int -> b) -> Benchmark
|
||||
benchPureSink value name = benchIO name (sourceIntFromTo value)
|
||||
|
||||
{-# INLINE benchIO' #-}
|
||||
benchIO' :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark
|
||||
benchIO' name src f = bench name $ nfIO $
|
||||
randomRIO (1,1) >>= src >>= f
|
||||
|
||||
{-# INLINE benchIOSink #-}
|
||||
benchIOSink :: NFData b => Int -> String -> (Stream Int -> IO b) -> Benchmark
|
||||
benchIOSink value name = benchIO' name (sourceIntFromTo value)
|
||||
|
||||
-- Drain a source that generates an array in the IO monad
|
||||
{-# INLINE benchIOSrc #-}
|
||||
benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark
|
||||
benchIOSrc name src = benchIO name src id
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Bench Ops
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
{-# INLINE sourceUnfoldr #-}
|
||||
sourceUnfoldr :: MonadIO m => Int -> Int -> m (Stream Int)
|
||||
sourceUnfoldr value n =
|
||||
Stream.fold (MArray.writeN value) $ Stream.unfoldr step n
|
||||
|
||||
where
|
||||
|
||||
step cnt =
|
||||
if cnt > n + value
|
||||
then Nothing
|
||||
else Just (cnt, cnt + 1)
|
||||
|
||||
{-# INLINE sourceIntFromTo #-}
|
||||
sourceIntFromTo :: MonadIO m => Int -> Int -> m (Stream Int)
|
||||
sourceIntFromTo value n =
|
||||
Stream.fold (MArray.writeN value) $ Stream.enumerateFromTo n (n + value)
|
||||
|
||||
{-# INLINE sourceFromList #-}
|
||||
sourceFromList :: MonadIO m => Int -> Int -> m (Stream Int)
|
||||
sourceFromList value n =
|
||||
Stream.fold (MArray.writeN value) $ Stream.fromList [n .. n + value]
|
||||
|
||||
{-# INLINE sourceIntFromToFromList #-}
|
||||
sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)
|
||||
sourceIntFromToFromList value n = MArray.fromListN value [n..n + value]
|
||||
|
||||
{-# INLINE sourceIntFromToFromStream #-}
|
||||
sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)
|
||||
sourceIntFromToFromStream value n =
|
||||
Stream.fold MArray.write $ Stream.enumerateFromTo n (n + value)
|
||||
|
||||
{-# INLINE sourceUnfoldrM #-}
|
||||
sourceUnfoldrM :: (IsStream t, MonadAsync m) => Int -> Int -> t m Int
|
||||
sourceUnfoldrM value n = Stream.unfoldrM step n
|
||||
@ -43,29 +122,140 @@ sourceUnfoldrM value n = Stream.unfoldrM step n
|
||||
then return Nothing
|
||||
else return (Just (cnt, cnt + 1))
|
||||
|
||||
{-# INLINE benchIO #-}
|
||||
benchIO
|
||||
:: NFData b
|
||||
=> String -> (Int -> a) -> (a -> IO b) -> Benchmark
|
||||
benchIO name src sink =
|
||||
bench name $ nfIO $ randomRIO (1,1) >>= sink . src
|
||||
-------------------------------------------------------------------------------
|
||||
-- Transformation
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
{-# INLINE composeN #-}
|
||||
composeN :: Monad m
|
||||
=> Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int)
|
||||
composeN n f x =
|
||||
case n of
|
||||
1 -> f x
|
||||
2 -> f x >>= f
|
||||
3 -> f x >>= f >>= f
|
||||
4 -> f x >>= f >>= f >>= f
|
||||
_ -> undefined
|
||||
|
||||
{-# INLINE scanl' #-}
|
||||
scanl' :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)
|
||||
scanl' value n = composeN n $ onArray value $ Stream.scanl' (+) 0
|
||||
|
||||
{-# INLINE scanl1' #-}
|
||||
scanl1' :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)
|
||||
scanl1' value n = composeN n $ onArray value $ Stream.scanl1' (+)
|
||||
|
||||
{-# INLINE map #-}
|
||||
map :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)
|
||||
map value n = composeN n $ onArray value $ Stream.map (+ 1)
|
||||
|
||||
{-# INLINE onArray #-}
|
||||
onArray
|
||||
:: MonadIO m => Int -> (Stream.SerialT m Int -> Stream.SerialT m Int)
|
||||
-> Stream Int
|
||||
-> m (Stream Int)
|
||||
onArray value f arr =
|
||||
Stream.fold (MArray.writeN value) $ f $ Stream.unfold MArray.read arr
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Elimination
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
{-# INLINE unfoldReadDrain #-}
|
||||
unfoldReadDrain :: MonadIO m => Stream Int -> m ()
|
||||
unfoldReadDrain = Stream.drain . Stream.unfold MArray.read
|
||||
|
||||
{-# INLINE unfoldReadRevDrain #-}
|
||||
unfoldReadRevDrain :: MonadIO m => Stream Int -> m ()
|
||||
unfoldReadRevDrain = Stream.drain . Stream.unfold MArray.readRev
|
||||
|
||||
{-# INLINE toStreamDRevDrain #-}
|
||||
toStreamDRevDrain :: MonadIO m => Stream Int -> m ()
|
||||
toStreamDRevDrain =
|
||||
Stream.drain . SerialT . StreamD.toStreamK . MArray.toStreamDRev
|
||||
|
||||
{-# INLINE toStreamDDrain #-}
|
||||
toStreamDDrain :: MonadIO m => Stream Int -> m ()
|
||||
toStreamDDrain = Stream.drain . SerialT . StreamD.toStreamK . MArray.toStreamD
|
||||
|
||||
{-# INLINE unfoldFold #-}
|
||||
unfoldFold :: MonadIO m => Stream Int -> m Int
|
||||
unfoldFold = Stream.foldl' (+) 0 . Stream.unfold MArray.read
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Bench groups
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
o_1_space_generation :: Int -> [Benchmark]
|
||||
o_1_space_generation value =
|
||||
[ bgroup
|
||||
"generation"
|
||||
[ benchIOSrc "writeN . intFromTo" (sourceIntFromTo value)
|
||||
, benchIOSrc
|
||||
"fromList . intFromTo"
|
||||
(sourceIntFromToFromList value)
|
||||
, benchIOSrc "writeN . unfoldr" (sourceUnfoldr value)
|
||||
, benchIOSrc "writeN . fromList" (sourceFromList value)
|
||||
, benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)
|
||||
]
|
||||
]
|
||||
|
||||
o_1_space_elimination :: Int -> [Benchmark]
|
||||
o_1_space_elimination value =
|
||||
[ bgroup "elimination"
|
||||
[ benchPureSink value "id" id
|
||||
, benchIOSink value "foldl'" unfoldFold
|
||||
, benchIOSink value "read" unfoldReadDrain
|
||||
, benchIOSink value "readRev" unfoldReadRevDrain
|
||||
, benchIOSink value "toStream" toStreamDDrain
|
||||
, benchIOSink value "toStreamRev" toStreamDRevDrain
|
||||
]
|
||||
]
|
||||
|
||||
o_n_heap_serial :: Int -> [Benchmark]
|
||||
o_n_heap_serial value =
|
||||
[ bgroup "elimination"
|
||||
[
|
||||
-- Converting the stream to an array
|
||||
benchFold "writeN" (Stream.fold (MArray.writeN value))
|
||||
(sourceUnfoldrM value)
|
||||
]
|
||||
]
|
||||
|
||||
o_1_space_transformation :: Int -> [Benchmark]
|
||||
o_1_space_transformation value =
|
||||
[ bgroup "transformation"
|
||||
[ benchIOSink value "scanl'" (scanl' value 1)
|
||||
, benchIOSink value "scanl1'" (scanl1' value 1)
|
||||
, benchIOSink value "map" (map value 1)
|
||||
]
|
||||
]
|
||||
|
||||
o_1_space_transformationX4 :: Int -> [Benchmark]
|
||||
o_1_space_transformationX4 value =
|
||||
[ bgroup "transformationX4"
|
||||
[ benchIOSink value "scanl'" (scanl' value 4)
|
||||
, benchIOSink value "scanl1'" (scanl1' value 4)
|
||||
, benchIOSink value "map" (map value 4)
|
||||
]
|
||||
]
|
||||
|
||||
o_1_space_serial_marray ::
|
||||
Int -> (MArray.Array Int, Array.Array Int) -> [Benchmark]
|
||||
o_1_space_serial_marray value ~(array, indices) =
|
||||
[ benchIO "partitionBy (< 0)" (const array)
|
||||
[ benchIO' "partitionBy (< 0)" (const (return array))
|
||||
$ MArray.partitionBy (< 0)
|
||||
, benchIO "partitionBy (> 0)" (const array)
|
||||
, benchIO' "partitionBy (> 0)" (const (return array))
|
||||
$ MArray.partitionBy (> 0)
|
||||
, benchIO "partitionBy (< value/2)" (const array)
|
||||
, benchIO' "partitionBy (< value/2)" (const (return array))
|
||||
$ MArray.partitionBy (< (value `div` 2))
|
||||
, benchIO "partitionBy (> value/2)" (const array)
|
||||
, benchIO' "partitionBy (> value/2)" (const (return array))
|
||||
$ MArray.partitionBy (> (value `div` 2))
|
||||
, benchIO "strip (< value/2 || > value/2)" (const array)
|
||||
, benchIO' "strip (< value/2 || > value/2)" (const (return array))
|
||||
$ MArray.strip (\x -> x < value `div` 2 || x > value `div` 2)
|
||||
, benchIO "strip (> 0)" (const array)
|
||||
, benchIO' "strip (> 0)" (const (return array))
|
||||
$ MArray.strip (> 0)
|
||||
, benchIO "modifyIndices (+ 1)" (const indices)
|
||||
, benchIO' "modifyIndices (+ 1)" (const (return indices))
|
||||
$ Stream.fold (MArray.modifyIndices (\_idx val -> val + 1) array)
|
||||
. Stream.unfold Array.read
|
||||
]
|
||||
@ -89,6 +279,13 @@ main = do
|
||||
return (marr, indices)
|
||||
|
||||
allBenchmarks array value =
|
||||
[ bgroup (o_1_space_prefix moduleName) $
|
||||
o_1_space_serial_marray value array
|
||||
[ bgroup (o_1_space_prefix moduleName)
|
||||
$ concat
|
||||
[ o_1_space_serial_marray value array
|
||||
, o_1_space_generation value
|
||||
, o_1_space_elimination value
|
||||
, o_1_space_transformation value
|
||||
, o_1_space_transformationX4 value
|
||||
]
|
||||
, bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
|
||||
]
|
||||
|
||||
@ -537,6 +537,8 @@ benchmark Data.Array.Foreign.Mut
|
||||
import: bench-options
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Streamly/Benchmark/Data/Array/Foreign/Mut.hs
|
||||
if flag(limit-build-mem)
|
||||
ghc-options: +RTS -M1500M -RTS
|
||||
if flag(bench-core)
|
||||
buildable: False
|
||||
else
|
||||
|
||||
@ -100,6 +100,12 @@ targets =
|
||||
, "pinned_array_cmp"
|
||||
]
|
||||
)
|
||||
, ("Data.Array.Foreign.Mut",
|
||||
[ "array_grp"
|
||||
, "array_cmp"
|
||||
, "noTest"
|
||||
]
|
||||
)
|
||||
, ("Data.Array.Prim",
|
||||
[ "array_grp"
|
||||
, "array_cmp"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user