mirror of
https://github.com/composewell/streamly.git
synced 2024-09-20 07:58:27 +03:00
1949eb90af
* Implement a stream flavor specific (concurrent/wSerial etc.) concatMap (concatMapBy). Now concatMap has the same capabilities that the monad bind of different streams has. In fact the monad bind is implemented using concatMap * Use foldr/build fusion for concatMap (currently disabled) and for map/fmap and mapM (enabled) * Add benchmarks for bind/concatMap performance
165 lines
4.5 KiB
Haskell
165 lines
4.5 KiB
Haskell
-- |
|
|
-- Module : BenchmarkOps
|
|
-- Copyright : (c) 2018 Harendra Kumar
|
|
--
|
|
-- License : MIT
|
|
-- Maintainer : harendra.kumar@gmail.com
|
|
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
module NestedOps where
|
|
|
|
import Control.Exception (try)
|
|
import GHC.Exception (ErrorCall)
|
|
|
|
import qualified Streamly as S hiding (runStream)
|
|
import qualified Streamly.Prelude as S
|
|
|
|
linearCount :: Int
|
|
linearCount = 100000
|
|
|
|
-- double nested loop
|
|
nestedCount2 :: Int
|
|
-- nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
|
|
nestedCount2 = 100
|
|
|
|
-- triple nested loop
|
|
nestedCount3 :: Int
|
|
nestedCount3 = round (fromIntegral linearCount**(1/3::Double))
|
|
|
|
-------------------------------------------------------------------------------
|
|
-- Stream generation and elimination
|
|
-------------------------------------------------------------------------------
|
|
|
|
type Stream m a = S.SerialT m a
|
|
|
|
{-# INLINE source #-}
|
|
source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
|
|
source = sourceUnfoldrM
|
|
|
|
{-# INLINE sourceUnfoldrM #-}
|
|
sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
|
|
sourceUnfoldrM n value = S.serially $ S.unfoldrM step n
|
|
where
|
|
step cnt =
|
|
if cnt > n + value
|
|
then return Nothing
|
|
else return (Just (cnt, cnt + 1))
|
|
|
|
{-# INLINE sourceUnfoldr #-}
|
|
sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
|
|
sourceUnfoldr start n = S.unfoldr step start
|
|
where
|
|
step cnt =
|
|
if cnt > start + n
|
|
then Nothing
|
|
else Just (cnt, cnt + 1)
|
|
|
|
{-# INLINE runStream #-}
|
|
runStream :: Monad m => Stream m a -> m ()
|
|
runStream = S.drain
|
|
|
|
{-# INLINE runToList #-}
|
|
runToList :: Monad m => Stream m a -> m [a]
|
|
runToList = S.toList
|
|
|
|
-------------------------------------------------------------------------------
|
|
-- Benchmark ops
|
|
-------------------------------------------------------------------------------
|
|
|
|
{-# INLINE toNullAp #-}
|
|
toNullAp
|
|
:: (S.IsStream t, S.MonadAsync m, Monad (t m))
|
|
=> (t m Int -> S.SerialT m Int) -> Int -> m ()
|
|
toNullAp t start = runStream . t $
|
|
(+) <$> source start nestedCount2 <*> source start nestedCount2
|
|
|
|
{-# INLINE toNull #-}
|
|
toNull
|
|
:: (S.IsStream t, S.MonadAsync m, Monad (t m))
|
|
=> (t m Int -> S.SerialT m Int) -> Int -> m ()
|
|
toNull t start = runStream . t $ do
|
|
x <- source start nestedCount2
|
|
y <- source start nestedCount2
|
|
return $ x + y
|
|
|
|
{-# INLINE toNull3 #-}
|
|
toNull3
|
|
:: (S.IsStream t, S.MonadAsync m, Monad (t m))
|
|
=> (t m Int -> S.SerialT m Int) -> Int -> m ()
|
|
toNull3 t start = runStream . t $ do
|
|
x <- source start nestedCount3
|
|
y <- source start nestedCount3
|
|
z <- source start nestedCount3
|
|
return $ x + y + z
|
|
|
|
{-# INLINE toList #-}
|
|
toList
|
|
:: (S.IsStream t, S.MonadAsync m, Monad (t m))
|
|
=> (t m Int -> S.SerialT m Int) -> Int -> m [Int]
|
|
toList t start = runToList . t $ do
|
|
x <- source start nestedCount2
|
|
y <- source start nestedCount2
|
|
return $ x + y
|
|
|
|
{-# INLINE toListSome #-}
|
|
toListSome
|
|
:: (S.IsStream t, S.MonadAsync m, Monad (t m))
|
|
=> (t m Int -> S.SerialT m Int) -> Int -> m [Int]
|
|
toListSome t start =
|
|
runToList . t $ S.take 1000 $ do
|
|
x <- source start nestedCount2
|
|
y <- source start nestedCount2
|
|
return $ x + y
|
|
|
|
{-# INLINE filterAllOut #-}
|
|
filterAllOut
|
|
:: (S.IsStream t, S.MonadAsync m, Monad (t m))
|
|
=> (t m Int -> S.SerialT m Int) -> Int -> m ()
|
|
filterAllOut t start = runStream . t $ do
|
|
x <- source start nestedCount2
|
|
y <- source start nestedCount2
|
|
let s = x + y
|
|
if s < 0
|
|
then return s
|
|
else S.nil
|
|
|
|
{-# INLINE filterAllIn #-}
|
|
filterAllIn
|
|
:: (S.IsStream t, S.MonadAsync m, Monad (t m))
|
|
=> (t m Int -> S.SerialT m Int) -> Int -> m ()
|
|
filterAllIn t start = runStream . t $ do
|
|
x <- source start nestedCount2
|
|
y <- source start nestedCount2
|
|
let s = x + y
|
|
if s > 0
|
|
then return s
|
|
else S.nil
|
|
|
|
{-# INLINE filterSome #-}
|
|
filterSome
|
|
:: (S.IsStream t, S.MonadAsync m, Monad (t m))
|
|
=> (t m Int -> S.SerialT m Int) -> Int -> m ()
|
|
filterSome t start = runStream . t $ do
|
|
x <- source start nestedCount2
|
|
y <- source start nestedCount2
|
|
let s = x + y
|
|
if s > 1100000
|
|
then return s
|
|
else S.nil
|
|
|
|
{-# INLINE breakAfterSome #-}
|
|
breakAfterSome
|
|
:: (S.IsStream t, Monad (t IO))
|
|
=> (t IO Int -> S.SerialT IO Int) -> Int -> IO ()
|
|
breakAfterSome t start = do
|
|
(_ :: Either ErrorCall ()) <- try $ runStream . t $ do
|
|
x <- source start nestedCount2
|
|
y <- source start nestedCount2
|
|
let s = x + y
|
|
if s > 1100000
|
|
then error "break"
|
|
else return s
|
|
return ()
|