on master help sign in
Fix performance of monad-outer-product benchmarks
commit354f337c80be3aa39b2b7a0c65e180fe8d65afbb authorHarendra Kumar <harendra@composewell.com> dateMon 8 Jun 2020, 14:37 (6 years ago) parent294aa21
1 file changed+20−20
benchmark/lib/Streamly/Benchmark/Prelude.hs+20−20
benchmark/lib/Streamly/Benchmark/Prelude.hs+20−20
@@ -173,7 +173,7 @@ benchIOSrc
173173benchIOSrc t name f =
174174 bench name $ nfIO $ randomRIO (1,1) >>= toNull t . f
175175
176−{-# INLINE benchIO #-}
176+{-# NOINLINE benchIO #-}
177177benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
178178benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
179179
@@ -351,8 +351,8 @@ toNullAp
351351 :: (S.IsStream t, S.MonadAsync m, Applicative (t m))
352352 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
353353toNullAp linearCount t start = S.drain . t $
354− (+) <$> sourceUnfoldrM nestedCount2 start
355− <*> sourceUnfoldrM nestedCount2 start
354+ (+) <$> S.serially (sourceUnfoldrM nestedCount2 start)
355+ <*> S.serially (sourceUnfoldrM nestedCount2 start)
356356
357357 where
358358
@@ -363,8 +363,8 @@ toNullM
363363 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
364364 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
365365toNullM linearCount t start = S.drain . t $ do
366− x <- sourceUnfoldrM nestedCount2 start
367− y <- sourceUnfoldrM nestedCount2 start
366+ x <- S.serially $ sourceUnfoldrM nestedCount2 start
367+ y <- S.serially $ sourceUnfoldrM nestedCount2 start
368368 return $ x + y
369369
370370 where
@@ -376,9 +376,9 @@ toNullM3
376376 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
377377 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
378378toNullM3 linearCount t start = S.drain . t $ do
379− x <- sourceUnfoldrM nestedCount3 start
380− y <- sourceUnfoldrM nestedCount3 start
381− z <- sourceUnfoldrM nestedCount3 start
379+ x <- S.serially $ sourceUnfoldrM nestedCount3 start
380+ y <- S.serially $ sourceUnfoldrM nestedCount3 start
381+ z <- S.serially $ sourceUnfoldrM nestedCount3 start
382382 return $ x + y + z
383383 where
384384 nestedCount3 = round (fromIntegral linearCount**(1/3::Double))
@@ -388,8 +388,8 @@ toListM
388388 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
389389 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m [Int]
390390toListM linearCount t start = runToList . t $ do
391− x <- sourceUnfoldrM nestedCount2 start
392− y <- sourceUnfoldrM nestedCount2 start
391+ x <- S.serially $ sourceUnfoldrM nestedCount2 start
392+ y <- S.serially $ sourceUnfoldrM nestedCount2 start
393393 return $ x + y
394394 where
395395 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
@@ -402,8 +402,8 @@ toListSome
402402 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m [Int]
403403toListSome linearCount t start =
404404 runToList . t $ S.take 10000 $ do
405− x <- sourceUnfoldrM nestedCount2 start
406− y <- sourceUnfoldrM nestedCount2 start
405+ x <- S.serially $ sourceUnfoldrM nestedCount2 start
406+ y <- S.serially $ sourceUnfoldrM nestedCount2 start
407407 return $ x + y
408408 where
409409 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
@@ -413,8 +413,8 @@ filterAllOutM
413413 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
414414 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
415415filterAllOutM linearCount t start = S.drain . t $ do
416− x <- sourceUnfoldrM nestedCount2 start
417− y <- sourceUnfoldrM nestedCount2 start
416+ x <- S.serially $ sourceUnfoldrM nestedCount2 start
417+ y <- S.serially $ sourceUnfoldrM nestedCount2 start
418418 let s = x + y
419419 if s < 0
420420 then return s
@@ -427,8 +427,8 @@ filterAllInM
427427 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
428428 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
429429filterAllInM linearCount t start = S.drain . t $ do
430− x <- sourceUnfoldrM nestedCount2 start
431− y <- sourceUnfoldrM nestedCount2 start
430+ x <- S.serially $ sourceUnfoldrM nestedCount2 start
431+ y <- S.serially $ sourceUnfoldrM nestedCount2 start
432432 let s = x + y
433433 if s > 0
434434 then return s
@@ -441,8 +441,8 @@ filterSome
441441 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
442442 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
443443filterSome linearCount t start = S.drain . t $ do
444− x <- sourceUnfoldrM nestedCount2 start
445− y <- sourceUnfoldrM nestedCount2 start
444+ x <- S.serially $ sourceUnfoldrM nestedCount2 start
445+ y <- S.serially $ sourceUnfoldrM nestedCount2 start
446446 let s = x + y
447447 if s > 1100000
448448 then return s
@@ -456,8 +456,8 @@ breakAfterSome
456456 => Int -> (t IO Int -> S.SerialT IO Int) -> Int -> IO ()
457457breakAfterSome linearCount t start = do
458458 (_ :: Either ErrorCall ()) <- try $ S.drain . t $ do
459− x <- sourceUnfoldrM nestedCount2 start
460− y <- sourceUnfoldrM nestedCount2 start
459+ x <- S.serially $ sourceUnfoldrM nestedCount2 start
460+ y <- S.serially $ sourceUnfoldrM nestedCount2 start
461461 let s = x + y
462462 if s > 1100000
463463 then error "break"