git.iko.soy/streamly
on cee86ff help sign in
streamly/benchmark/NestedOps.hs
174 lines 5.4 kB history raw
1-- |
2-- Module : BenchmarkOps
3-- Copyright : (c) 2018 Harendra Kumar
4--
5-- License : MIT
6-- Maintainer : streamly@composewell.com
8{-# LANGUAGE CPP #-}
9{-# LANGUAGE FlexibleContexts #-}
10{-# LANGUAGE ScopedTypeVariables #-}
12module NestedOps where
14import Control.Exception (try)
15import GHC.Exception (ErrorCall)
17import qualified Streamly as S hiding (runStream)
18import qualified Streamly.Prelude as S
20-------------------------------------------------------------------------------
21-- Stream generation and elimination
22-------------------------------------------------------------------------------
24type Stream m a = S.SerialT m a
26{-# INLINE source #-}
27source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
28source = sourceUnfoldrM
30-- Change this to "sourceUnfoldrM value n" for consistency
31{-# INLINE sourceUnfoldrM #-}
32sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
33sourceUnfoldrM n value = S.serially $ S.unfoldrM step n
34 where
35 step cnt =
36 if cnt > n + value
37 then return Nothing
38 else return (Just (cnt, cnt + 1))
40{-# INLINE sourceUnfoldr #-}
41sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
42sourceUnfoldr start n = S.unfoldr step start
43 where
44 step cnt =
45 if cnt > start + n
46 then Nothing
47 else Just (cnt, cnt + 1)
49{-# INLINE runStream #-}
50runStream :: Monad m => Stream m a -> m ()
51runStream = S.drain
53{-# INLINE runToList #-}
54runToList :: Monad m => Stream m a -> m [a]
55runToList = S.toList
57-------------------------------------------------------------------------------
58-- Benchmark ops
59-------------------------------------------------------------------------------
61{-# INLINE toNullAp #-}
62toNullAp
63 :: (S.IsStream t, S.MonadAsync m, Applicative (t m))
64 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
65toNullAp linearCount t start = runStream . t $
66 (+) <$> source start nestedCount2 <*> source start nestedCount2
67 where
68 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
70{-# INLINE toNull #-}
71toNull
72 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
73 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
74toNull linearCount t start = runStream . t $ do
75 x <- source start nestedCount2
76 y <- source start nestedCount2
77 return $ x + y
78 where
79 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
81{-# INLINE toNull3 #-}
82toNull3
83 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
84 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
85toNull3 linearCount t start = runStream . t $ do
86 x <- source start nestedCount3
87 y <- source start nestedCount3
88 z <- source start nestedCount3
89 return $ x + y + z
90 where
91 nestedCount3 = round (fromIntegral linearCount**(1/3::Double))
93{-# INLINE toList #-}
94toList
95 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
96 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m [Int]
97toList linearCount t start = runToList . t $ do
98 x <- source start nestedCount2
99 y <- source start nestedCount2
100 return $ x + y
101 where
102 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
104-- Taking a specified number of elements is very expensive in logict so we have
105-- a test to measure the same.
106{-# INLINE toListSome #-}
107toListSome
108 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
109 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m [Int]
110toListSome linearCount t start =
111 runToList . t $ S.take 10000 $ do
112 x <- source start nestedCount2
113 y <- source start nestedCount2
114 return $ x + y
115 where
116 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
118{-# INLINE filterAllOut #-}
119filterAllOut
120 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
121 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
122filterAllOut linearCount t start = runStream . t $ do
123 x <- source start nestedCount2
124 y <- source start nestedCount2
125 let s = x + y
126 if s < 0
127 then return s
128 else S.nil
129 where
130 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
132{-# INLINE filterAllIn #-}
133filterAllIn
134 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
135 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
136filterAllIn linearCount t start = runStream . t $ do
137 x <- source start nestedCount2
138 y <- source start nestedCount2
139 let s = x + y
140 if s > 0
141 then return s
142 else S.nil
143 where
144 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
146{-# INLINE filterSome #-}
147filterSome
148 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
149 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
150filterSome linearCount t start = runStream . t $ do
151 x <- source start nestedCount2
152 y <- source start nestedCount2
153 let s = x + y
154 if s > 1100000
155 then return s
156 else S.nil
157 where
158 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
160{-# INLINE breakAfterSome #-}
161breakAfterSome
162 :: (S.IsStream t, Monad (t IO))
163 => Int -> (t IO Int -> S.SerialT IO Int) -> Int -> IO ()
164breakAfterSome linearCount t start = do
165 (_ :: Either ErrorCall ()) <- try $ runStream . t $ do
166 x <- source start nestedCount2
167 y <- source start nestedCount2
168 let s = x + y
169 if s > 1100000
170 then error "break"
171 else return s
172 return ()
173 where
174 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))