git.iko.soy/streamly
on 43179a2 help sign in
streamly/benchmark/NestedOps.hs
172 lines 5.3 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{-# INLINE toListSome #-}
105toListSome
106 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
107 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m [Int]
108toListSome linearCount t start =
109 runToList . t $ S.take 1000 $ do
110 x <- source start nestedCount2
111 y <- source start nestedCount2
112 return $ x + y
113 where
114 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
116{-# INLINE filterAllOut #-}
117filterAllOut
118 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
119 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
120filterAllOut linearCount t start = runStream . t $ do
121 x <- source start nestedCount2
122 y <- source start nestedCount2
123 let s = x + y
124 if s < 0
125 then return s
126 else S.nil
127 where
128 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
130{-# INLINE filterAllIn #-}
131filterAllIn
132 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
133 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
134filterAllIn linearCount t start = runStream . t $ do
135 x <- source start nestedCount2
136 y <- source start nestedCount2
137 let s = x + y
138 if s > 0
139 then return s
140 else S.nil
141 where
142 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
144{-# INLINE filterSome #-}
145filterSome
146 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
147 => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
148filterSome linearCount t start = runStream . t $ do
149 x <- source start nestedCount2
150 y <- source start nestedCount2
151 let s = x + y
152 if s > 1100000
153 then return s
154 else S.nil
155 where
156 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
158{-# INLINE breakAfterSome #-}
159breakAfterSome
160 :: (S.IsStream t, Monad (t IO))
161 => Int -> (t IO Int -> S.SerialT IO Int) -> Int -> IO ()
162breakAfterSome linearCount t start = do
163 (_ :: Either ErrorCall ()) <- try $ runStream . t $ do
164 x <- source start nestedCount2
165 y <- source start nestedCount2
166 let s = x + y
167 if s > 1100000
168 then error "break"
169 else return s
170 return ()
171 where
172 nestedCount2 = round (fromIntegral linearCount**(1/2::Double))