git.iko.soy/streamly
on 6cd235f help sign in
streamly/benchmark/NestedOps.hs
148 lines 4.1 kB history raw
1-- |
2-- Module : BenchmarkOps
3-- Copyright : (c) 2018 Harendra Kumar
4--
5-- License : MIT
6-- Maintainer : harendra.kumar@gmail.com
8{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE ScopedTypeVariables #-}
11module NestedOps where
13import Control.Exception (try)
14import GHC.Exception (ErrorCall)
16import qualified Streamly as S hiding (runStream)
17import qualified Streamly.Prelude as S
19sumCount :: Int
20sumCount = 1000000
22prodCount :: Int
23prodCount = 100
25-------------------------------------------------------------------------------
26-- Stream generation and elimination
27-------------------------------------------------------------------------------
29type Stream m a = S.SerialT m a
31{-# INLINE source #-}
32source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
33source = sourceUnfoldrM
35{-# INLINE sourceUnfoldrM #-}
36sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
37sourceUnfoldrM n value = S.serially $ S.unfoldrM step n
38 where
39 step cnt =
40 if cnt > n + value
41 then return Nothing
42 else return (Just (cnt, cnt + 1))
44{-# INLINE sourceUnfoldr #-}
45sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
46sourceUnfoldr start n = S.unfoldr step start
47 where
48 step cnt =
49 if cnt > start + n
50 then Nothing
51 else Just (cnt, cnt + 1)
53{-# INLINE runStream #-}
54runStream :: Monad m => Stream m a -> m ()
55runStream = S.drain
57{-# INLINE runToList #-}
58runToList :: Monad m => Stream m a -> m [a]
59runToList = S.toList
61-------------------------------------------------------------------------------
62-- Benchmark ops
63-------------------------------------------------------------------------------
65{-# INLINE toNullAp #-}
66toNullAp
67 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
68 => (t m Int -> S.SerialT m Int) -> Int -> m ()
69toNullAp t start = runStream . t $
70 (+) <$> source start prodCount <*> source start prodCount
72{-# INLINE toNull #-}
73toNull
74 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
75 => (t m Int -> S.SerialT m Int) -> Int -> m ()
76toNull t start = runStream . t $ do
77 x <- source start prodCount
78 y <- source start prodCount
79 return $ x + y
81{-# INLINE toList #-}
82toList
83 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
84 => (t m Int -> S.SerialT m Int) -> Int -> m [Int]
85toList t start = runToList . t $ do
86 x <- source start prodCount
87 y <- source start prodCount
88 return $ x + y
90{-# INLINE toListSome #-}
91toListSome
92 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
93 => (t m Int -> S.SerialT m Int) -> Int -> m [Int]
94toListSome t start =
95 runToList . t $ S.take 1000 $ do
96 x <- source start prodCount
97 y <- source start prodCount
98 return $ x + y
100{-# INLINE filterAllOut #-}
101filterAllOut
102 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
103 => (t m Int -> S.SerialT m Int) -> Int -> m ()
104filterAllOut t start = runStream . t $ do
105 x <- source start prodCount
106 y <- source start prodCount
107 let s = x + y
108 if s < 0
109 then return s
110 else S.nil
112{-# INLINE filterAllIn #-}
113filterAllIn
114 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
115 => (t m Int -> S.SerialT m Int) -> Int -> m ()
116filterAllIn t start = runStream . t $ do
117 x <- source start prodCount
118 y <- source start prodCount
119 let s = x + y
120 if s > 0
121 then return s
122 else S.nil
124{-# INLINE filterSome #-}
125filterSome
126 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
127 => (t m Int -> S.SerialT m Int) -> Int -> m ()
128filterSome t start = runStream . t $ do
129 x <- source start prodCount
130 y <- source start prodCount
131 let s = x + y
132 if s > 1100000
133 then return s
134 else S.nil
136{-# INLINE breakAfterSome #-}
137breakAfterSome
138 :: (S.IsStream t, Monad (t IO))
139 => (t IO Int -> S.SerialT IO Int) -> Int -> IO ()
140breakAfterSome t start = do
141 (_ :: Either ErrorCall ()) <- try $ runStream . t $ do
142 x <- source start prodCount
143 y <- source start prodCount
144 let s = x + y
145 if s > 1100000
146 then error "break"
147 else return s
148 return ()