benchmark/Streamly/Benchmark/Data/Array/Mut.hs · streamly

git.iko.soy/streamly

on fe28607 help sign in

streamly/benchmark/Streamly/Benchmark/Data/Array/Mut.hs

296 lines 9.8 kB history raw

1{-# OPTIONS_GHC -Wno-deprecations #-}

3-- |

4-- Module : Streamly.Benchmark.Data.Array.Unboxed.Mut

6-- License : BSD-3-Clause

7-- Maintainer : streamly@composewell.com

9{-# LANGUAGE CPP #-}

10{-# LANGUAGE FlexibleContexts #-}

11{-# LANGUAGE ScopedTypeVariables #-}

13#ifdef __HADDOCK_VERSION__

14#undef INSPECTION

15#endif

17#ifdef INSPECTION

18{-# LANGUAGE TemplateHaskell #-}

19{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}

20#endif

22import Control.DeepSeq (NFData(..))

23import Control.Monad.IO.Class (MonadIO)

24import Data.Functor ((<&>))

25import System.Random (randomRIO)

26import Prelude

27 ( IO

28 , Int

29 , Integral(..)

30 , Maybe(..)

31 , Monad(..)

32 , Num(..)

33 , Ord(..)

34 , String

35 , ($)

36 , (.)

37 , (||)

38 , concat

39 , const

40 , fmap

41 , id

42 , undefined

43 )

45import qualified Streamly.Internal.Data.Array as Array

46import qualified Streamly.Internal.Data.Array.Mut as MArray

47import qualified Streamly.Internal.Data.Fold as Fold

48import qualified Streamly.Internal.Data.Stream as Stream

49import qualified Streamly.Prelude as IsStream (scanl1')

51import Gauge

52import Streamly.Benchmark.Common hiding (benchPureSrc)

54type Stream = MArray.Array

56-------------------------------------------------------------------------------

57-- Benchmark helpers

58-------------------------------------------------------------------------------

60{-# INLINE benchIO #-}

61benchIO :: NFData b => String -> (Int -> IO a) -> (a -> b) -> Benchmark

62benchIO name src f = bench name $ nfIO $

63 (randomRIO (1,1) >>= src) <&> f

65{-# INLINE benchPureSink #-}

66benchPureSink :: NFData b => Int -> String -> (Stream Int -> b) -> Benchmark

67benchPureSink value name = benchIO name (sourceIntFromTo value)

69{-# INLINE benchIO' #-}

70benchIO' :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark

71benchIO' name src f = bench name $ nfIO $

72 randomRIO (1,1) >>= src >>= f

74{-# INLINE benchIOSink #-}

75benchIOSink :: NFData b => Int -> String -> (Stream Int -> IO b) -> Benchmark

76benchIOSink value name = benchIO' name (sourceIntFromTo value)

78-- Drain a source that generates an array in the IO monad

79{-# INLINE benchIOSrc #-}

80benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark

81benchIOSrc name src = benchIO name src id

83drain :: Monad m => Stream.Stream m a -> m ()

84drain = Stream.fold Fold.drain

86-------------------------------------------------------------------------------

87-- Bench Ops

88-------------------------------------------------------------------------------

90{-# INLINE sourceUnfoldr #-}

91sourceUnfoldr :: MonadIO m => Int -> Int -> m (Stream Int)

92sourceUnfoldr value n =

93 Stream.fold (MArray.writeN value) $ Stream.unfoldr step n

95 where

97 step cnt =

98 if cnt > n + value

99 then Nothing

100 else Just (cnt, cnt + 1)

101

102{-# INLINE sourceIntFromTo #-}

103sourceIntFromTo :: MonadIO m => Int -> Int -> m (Stream Int)

104sourceIntFromTo value n =

105 Stream.fold (MArray.writeN value) $ Stream.enumerateFromTo n (n + value)

106

107{-# INLINE sourceFromList #-}

108sourceFromList :: MonadIO m => Int -> Int -> m (Stream Int)

109sourceFromList value n =

110 Stream.fold (MArray.writeN value) $ Stream.fromList [n .. n + value]

111

112{-# INLINE sourceIntFromToFromList #-}

113sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)

114sourceIntFromToFromList value n = MArray.fromListN value [n..n + value]

115

116{-# INLINE sourceIntFromToFromStream #-}

117sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)

118sourceIntFromToFromStream value n =

119 Stream.fold MArray.write $ Stream.enumerateFromTo n (n + value)

120

121{-# INLINE sourceUnfoldrM #-}

122sourceUnfoldrM :: Monad m => Int -> Int -> Stream.Stream m Int

123sourceUnfoldrM value n = Stream.unfoldrM step n

124 where

125 step cnt =

126 if cnt > n + value

127 then return Nothing

128 else return (Just (cnt, cnt + 1))

129

130-------------------------------------------------------------------------------

131-- Transformation

132-------------------------------------------------------------------------------

133

134{-# INLINE composeN #-}

135composeN :: Monad m

136 => Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int)

137composeN n f x =

138 case n of

139 1 -> f x

140 2 -> f x >>= f

141 3 -> f x >>= f >>= f

142 4 -> f x >>= f >>= f >>= f

143 _ -> undefined

144

145{-# INLINE scanl' #-}

146scanl' :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)

147scanl' value n = composeN n $ onArray value $ Stream.scan (Fold.foldl' (+) 0)

148

149{-# INLINE scanl1' #-}

150scanl1' :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)

151scanl1' value n = composeN n $ onArray value $ IsStream.scanl1' (+)

152

153{-# INLINE map #-}

154map :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)

155map value n = composeN n $ onArray value $ fmap (+ 1)

156

157{-# INLINE onArray #-}

158onArray

159 :: MonadIO m => Int -> (Stream.Stream m Int -> Stream.Stream m Int)

160 -> Stream Int

161 -> m (Stream Int)

162onArray value f arr =

163 Stream.fold (MArray.writeN value) $ f $ Stream.unfold MArray.reader arr

164

165-------------------------------------------------------------------------------

166-- Elimination

167-------------------------------------------------------------------------------

168

169{-# INLINE unfoldReadDrain #-}

170unfoldReadDrain :: MonadIO m => Stream Int -> m ()

171unfoldReadDrain = drain . Stream.unfold MArray.reader

172

173{-# INLINE unfoldReadRevDrain #-}

174unfoldReadRevDrain :: MonadIO m => Stream Int -> m ()

175unfoldReadRevDrain = drain . Stream.unfold MArray.readerRev

176

177{-# INLINE toStreamDRevDrain #-}

178toStreamDRevDrain :: MonadIO m => Stream Int -> m ()

179toStreamDRevDrain =

180 drain . Stream.fromStreamD . MArray.toStreamDRev

181

182{-# INLINE toStreamDDrain #-}

183toStreamDDrain :: MonadIO m => Stream Int -> m ()

184toStreamDDrain = drain . Stream.fromStreamD . MArray.toStreamD

185

186{-# INLINE unfoldFold #-}

187unfoldFold :: MonadIO m => Stream Int -> m Int

188unfoldFold = Stream.fold (Fold.foldl' (+) 0) . Stream.unfold MArray.reader

189

190-------------------------------------------------------------------------------

191-- Bench groups

192-------------------------------------------------------------------------------

193

194o_1_space_generation :: Int -> [Benchmark]

195o_1_space_generation value =

196 [ bgroup

197 "generation"

198 [ benchIOSrc "writeN . intFromTo" (sourceIntFromTo value)

199 , benchIOSrc

200 "fromList . intFromTo"

201 (sourceIntFromToFromList value)

202 , benchIOSrc "writeN . unfoldr" (sourceUnfoldr value)

203 , benchIOSrc "writeN . fromList" (sourceFromList value)

204 , benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)

205 ]

206 ]

207

208o_1_space_elimination :: Int -> [Benchmark]

209o_1_space_elimination value =

210 [ bgroup "elimination"

211 [ benchPureSink value "id" id

212 , benchIOSink value "foldl'" unfoldFold

213 , benchIOSink value "read" unfoldReadDrain

214 , benchIOSink value "readRev" unfoldReadRevDrain

215 , benchIOSink value "toStream" toStreamDDrain

216 , benchIOSink value "toStreamRev" toStreamDRevDrain

217 ]

218 ]

219

220o_n_heap_serial :: Int -> [Benchmark]

221o_n_heap_serial value =

222 [ bgroup "elimination"

223 [

224 -- Converting the stream to an array

225 benchFold "writeN" (Stream.fold (MArray.writeN value))

226 (sourceUnfoldrM value)

227 ]

228 ]

229

230o_1_space_transformation :: Int -> [Benchmark]

231o_1_space_transformation value =

232 [ bgroup "transformation"

233 [ benchIOSink value "scanl'" (scanl' value 1)

234 , benchIOSink value "scanl1'" (scanl1' value 1)

235 , benchIOSink value "map" (map value 1)

236 ]

237 ]

238

239o_1_space_transformationX4 :: Int -> [Benchmark]

240o_1_space_transformationX4 value =

241 [ bgroup "transformationX4"

242 [ benchIOSink value "scanl'" (scanl' value 4)

243 , benchIOSink value "scanl1'" (scanl1' value 4)

244 , benchIOSink value "map" (map value 4)

245 ]

246 ]

247

248o_1_space_serial_marray ::

249 Int -> (MArray.Array Int, Array.Array Int) -> [Benchmark]

250o_1_space_serial_marray value ~(array, indices) =

251 [ benchIO' "partitionBy (< 0)" (const (return array))

252 $ MArray.partitionBy (< 0)

253 , benchIO' "partitionBy (> 0)" (const (return array))

254 $ MArray.partitionBy (> 0)

255 , benchIO' "partitionBy (< value/2)" (const (return array))

256 $ MArray.partitionBy (< (value `div` 2))

257 , benchIO' "partitionBy (> value/2)" (const (return array))

258 $ MArray.partitionBy (> (value `div` 2))

259 , benchIO' "strip (< value/2 || > value/2)" (const (return array))

260 $ MArray.strip (\x -> x < value `div` 2 || x > value `div` 2)

261 , benchIO' "strip (> 0)" (const (return array))

262 $ MArray.strip (> 0)

263 , benchIO' "modifyIndices (+ 1)" (const (return indices))

264 $ Stream.fold (MArray.modifyIndices (\_idx val -> val + 1) array)

265 . Stream.unfold Array.reader

266 ]

267

268-------------------------------------------------------------------------------

269-- Driver

270-------------------------------------------------------------------------------

271

272moduleName :: String

273moduleName = "Data.Array.Mut"

274

275main :: IO ()

276main = do

277 runWithCLIOptsEnv defaultStreamSize alloc allBenchmarks

278

279 where

280

281 alloc value = do

282 marr <- MArray.fromStream (sourceUnfoldrM value 0 :: Stream.Stream IO Int)

283 indices <- Array.fromStream (sourceUnfoldrM value 0 :: Stream.Stream IO Int)

284 return (marr, indices)

285

286 allBenchmarks array value =

287 [ bgroup (o_1_space_prefix moduleName)

288 $ concat

289 [ o_1_space_serial_marray value array

290 , o_1_space_generation value

291 , o_1_space_elimination value

292 , o_1_space_transformation value

293 , o_1_space_transformationX4 value

294 ]

295 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)

296 ]