git.iko.soy/streamly
on 665e7df help sign in
streamly/benchmark/NestedOps.hs
168 lines 4.7 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
20linearCount :: Int
21#ifdef LONG_BENCHMARKS
22linearCount = 10000000
23#else
24linearCount = 100000
25#endif
27-- double nested loop
28nestedCount2 :: Int
29nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
31-- triple nested loop
32nestedCount3 :: Int
33nestedCount3 = round (fromIntegral linearCount**(1/3::Double))
35-------------------------------------------------------------------------------
36-- Stream generation and elimination
37-------------------------------------------------------------------------------
39type Stream m a = S.SerialT m a
41{-# INLINE source #-}
42source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
43source = sourceUnfoldrM
45{-# INLINE sourceUnfoldrM #-}
46sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
47sourceUnfoldrM n value = S.serially $ S.unfoldrM step n
48 where
49 step cnt =
50 if cnt > n + value
51 then return Nothing
52 else return (Just (cnt, cnt + 1))
54{-# INLINE sourceUnfoldr #-}
55sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
56sourceUnfoldr start n = S.unfoldr step start
57 where
58 step cnt =
59 if cnt > start + n
60 then Nothing
61 else Just (cnt, cnt + 1)
63{-# INLINE runStream #-}
64runStream :: Monad m => Stream m a -> m ()
65runStream = S.drain
67{-# INLINE runToList #-}
68runToList :: Monad m => Stream m a -> m [a]
69runToList = S.toList
71-------------------------------------------------------------------------------
72-- Benchmark ops
73-------------------------------------------------------------------------------
75{-# INLINE toNullAp #-}
76toNullAp
77 :: (S.IsStream t, S.MonadAsync m, Applicative (t m))
78 => (t m Int -> S.SerialT m Int) -> Int -> m ()
79toNullAp t start = runStream . t $
80 (+) <$> source start nestedCount2 <*> source start nestedCount2
82{-# INLINE toNull #-}
83toNull
84 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
85 => (t m Int -> S.SerialT m Int) -> Int -> m ()
86toNull t start = runStream . t $ do
87 x <- source start nestedCount2
88 y <- source start nestedCount2
89 return $ x + y
91{-# INLINE toNull3 #-}
92toNull3
93 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
94 => (t m Int -> S.SerialT m Int) -> Int -> m ()
95toNull3 t start = runStream . t $ do
96 x <- source start nestedCount3
97 y <- source start nestedCount3
98 z <- source start nestedCount3
99 return $ x + y + z
101{-# INLINE toList #-}
102toList
103 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
104 => (t m Int -> S.SerialT m Int) -> Int -> m [Int]
105toList t start = runToList . t $ do
106 x <- source start nestedCount2
107 y <- source start nestedCount2
108 return $ x + y
110{-# INLINE toListSome #-}
111toListSome
112 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
113 => (t m Int -> S.SerialT m Int) -> Int -> m [Int]
114toListSome t start =
115 runToList . t $ S.take 1000 $ do
116 x <- source start nestedCount2
117 y <- source start nestedCount2
118 return $ x + y
120{-# INLINE filterAllOut #-}
121filterAllOut
122 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
123 => (t m Int -> S.SerialT m Int) -> Int -> m ()
124filterAllOut t start = runStream . t $ do
125 x <- source start nestedCount2
126 y <- source start nestedCount2
127 let s = x + y
128 if s < 0
129 then return s
130 else S.nil
132{-# INLINE filterAllIn #-}
133filterAllIn
134 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
135 => (t m Int -> S.SerialT m Int) -> Int -> m ()
136filterAllIn 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
144{-# INLINE filterSome #-}
145filterSome
146 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
147 => (t m Int -> S.SerialT m Int) -> Int -> m ()
148filterSome 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
156{-# INLINE breakAfterSome #-}
157breakAfterSome
158 :: (S.IsStream t, Monad (t IO))
159 => (t IO Int -> S.SerialT IO Int) -> Int -> IO ()
160breakAfterSome t start = do
161 (_ :: Either ErrorCall ()) <- try $ runStream . t $ do
162 x <- source start nestedCount2
163 y <- source start nestedCount2
164 let s = x + y
165 if s > 1100000
166 then error "break"
167 else return s
168 return ()