git.iko.soy/streamly
on master help sign in
Fix performance of monad-outer-product benchmarks
354f337Harendra Kumar
benchmark/lib/Streamly/Benchmark/Prelude.hs+20−20
compare with master
unifiedsplit
@@ -173,7 +173,7 @@ benchIOSrc
173benchIOSrc t name f =
173benchIOSrc t name f =
174 bench name $ nfIO $ randomRIO (1,1) >>= toNull t . f
174 bench name $ nfIO $ randomRIO (1,1) >>= toNull t . f
175
175
176−{-# INLINE benchIO #-}
176+{-# NOINLINE benchIO #-}
177benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
177benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
178benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
178benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
179
179
@@ -351,8 +351,8 @@ toNullAp
351 :: (S.IsStream t, S.MonadAsync m, Applicative (t m))
351 :: (S.IsStream t, S.MonadAsync m, Applicative (t m))
352 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
352 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
353toNullAp linearCount t start = S.drain . t $
353toNullAp linearCount t start = S.drain . t $
354− (+) <$> sourceUnfoldrM nestedCount2 start
354+ (+) <$> S.serially (sourceUnfoldrM nestedCount2 start)
355− <*> sourceUnfoldrM nestedCount2 start
355+ <*> S.serially (sourceUnfoldrM nestedCount2 start)
356
356
357 where
357 where
358
358
@@ -363,8 +363,8 @@ toNullM
363 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
363 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
364 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
364 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
365toNullM linearCount t start = S.drain . t $ do
365toNullM linearCount t start = S.drain . t $ do
366− x <- sourceUnfoldrM nestedCount2 start
366+ x <- S.serially $ sourceUnfoldrM nestedCount2 start
367− y <- sourceUnfoldrM nestedCount2 start
367+ y <- S.serially $ sourceUnfoldrM nestedCount2 start
368 return $ x + y
368 return $ x + y
369
369
370 where
370 where
@@ -376,9 +376,9 @@ toNullM3
376 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
376 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
377 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
377 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
378toNullM3 linearCount t start = S.drain . t $ do
378toNullM3 linearCount t start = S.drain . t $ do
379− x <- sourceUnfoldrM nestedCount3 start
379+ x <- S.serially $ sourceUnfoldrM nestedCount3 start
380− y <- sourceUnfoldrM nestedCount3 start
380+ y <- S.serially $ sourceUnfoldrM nestedCount3 start
381− z <- sourceUnfoldrM nestedCount3 start
381+ z <- S.serially $ sourceUnfoldrM nestedCount3 start
382 return $ x + y + z
382 return $ x + y + z
383 where
383 where
384 nestedCount3 = round (fromIntegral linearCount**(1/3::Double))
384 nestedCount3 = round (fromIntegral linearCount**(1/3::Double))
@@ -388,8 +388,8 @@ toListM
388 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
388 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
389 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m [Int]
389 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m [Int]
390toListM linearCount t start = runToList . t $ do
390toListM linearCount t start = runToList . t $ do
391− x <- sourceUnfoldrM nestedCount2 start
391+ x <- S.serially $ sourceUnfoldrM nestedCount2 start
392− y <- sourceUnfoldrM nestedCount2 start
392+ y <- S.serially $ sourceUnfoldrM nestedCount2 start
393 return $ x + y
393 return $ x + y
394 where
394 where
395 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
395 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
@@ -402,8 +402,8 @@ toListSome
402 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m [Int]
402 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m [Int]
403toListSome linearCount t start =
403toListSome linearCount t start =
404 runToList . t $ S.take 10000 $ do
404 runToList . t $ S.take 10000 $ do
405− x <- sourceUnfoldrM nestedCount2 start
405+ x <- S.serially $ sourceUnfoldrM nestedCount2 start
406− y <- sourceUnfoldrM nestedCount2 start
406+ y <- S.serially $ sourceUnfoldrM nestedCount2 start
407 return $ x + y
407 return $ x + y
408 where
408 where
409 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
409 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
@@ -413,8 +413,8 @@ filterAllOutM
413 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
413 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
414 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
414 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
415filterAllOutM linearCount t start = S.drain . t $ do
415filterAllOutM linearCount t start = S.drain . t $ do
416− x <- sourceUnfoldrM nestedCount2 start
416+ x <- S.serially $ sourceUnfoldrM nestedCount2 start
417− y <- sourceUnfoldrM nestedCount2 start
417+ y <- S.serially $ sourceUnfoldrM nestedCount2 start
418 let s = x + y
418 let s = x + y
419 if s < 0
419 if s < 0
420 then return s
420 then return s
@@ -427,8 +427,8 @@ filterAllInM
427 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
427 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
428 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
428 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
429filterAllInM linearCount t start = S.drain . t $ do
429filterAllInM linearCount t start = S.drain . t $ do
430− x <- sourceUnfoldrM nestedCount2 start
430+ x <- S.serially $ sourceUnfoldrM nestedCount2 start
431− y <- sourceUnfoldrM nestedCount2 start
431+ y <- S.serially $ sourceUnfoldrM nestedCount2 start
432 let s = x + y
432 let s = x + y
433 if s > 0
433 if s > 0
434 then return s
434 then return s
@@ -441,8 +441,8 @@ filterSome
441 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
441 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
442 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
442 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
443filterSome linearCount t start = S.drain . t $ do
443filterSome linearCount t start = S.drain . t $ do
444− x <- sourceUnfoldrM nestedCount2 start
444+ x <- S.serially $ sourceUnfoldrM nestedCount2 start
445− y <- sourceUnfoldrM nestedCount2 start
445+ y <- S.serially $ sourceUnfoldrM nestedCount2 start
446 let s = x + y
446 let s = x + y
447 if s > 1100000
447 if s > 1100000
448 then return s
448 then return s
@@ -456,8 +456,8 @@ breakAfterSome
456 => Int -> (t IO Int -> S.SerialT IO Int) -> Int -> IO ()
456 => Int -> (t IO Int -> S.SerialT IO Int) -> Int -> IO ()
457breakAfterSome linearCount t start = do
457breakAfterSome linearCount t start = do
458 (_ :: Either ErrorCall ()) <- try $ S.drain . t $ do
458 (_ :: Either ErrorCall ()) <- try $ S.drain . t $ do
459− x <- sourceUnfoldrM nestedCount2 start
459+ x <- S.serially $ sourceUnfoldrM nestedCount2 start
460− y <- sourceUnfoldrM nestedCount2 start
460+ y <- S.serially $ sourceUnfoldrM nestedCount2 start
461 let s = x + y
461 let s = x + y
462 if s > 1100000
462 if s > 1100000
463 then error "break"
463 then error "break"