git.iko.soy/streamly
on 33b00a6 help sign in
streamly/benchmark/NestedOps.hs
164 lines 4.6 kB history raw
1-- |
2-- Module : BenchmarkOps
3-- Copyright : (c) 2018 Harendra Kumar
4--
5-- License : MIT
6-- Maintainer : streamly@composewell.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
19linearCount :: Int
20linearCount = 100000
22-- double nested loop
23nestedCount2 :: Int
24-- nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
25nestedCount2 = 100
27-- triple nested loop
28nestedCount3 :: Int
29nestedCount3 = round (fromIntegral linearCount**(1/3::Double))
31-------------------------------------------------------------------------------
32-- Stream generation and elimination
33-------------------------------------------------------------------------------
35type Stream m a = S.SerialT m a
37{-# INLINE source #-}
38source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
39source = sourceUnfoldrM
41{-# INLINE sourceUnfoldrM #-}
42sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
43sourceUnfoldrM n value = S.serially $ S.unfoldrM step n
44 where
45 step cnt =
46 if cnt > n + value
47 then return Nothing
48 else return (Just (cnt, cnt + 1))
50{-# INLINE sourceUnfoldr #-}
51sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
52sourceUnfoldr start n = S.unfoldr step start
53 where
54 step cnt =
55 if cnt > start + n
56 then Nothing
57 else Just (cnt, cnt + 1)
59{-# INLINE runStream #-}
60runStream :: Monad m => Stream m a -> m ()
61runStream = S.drain
63{-# INLINE runToList #-}
64runToList :: Monad m => Stream m a -> m [a]
65runToList = S.toList
67-------------------------------------------------------------------------------
68-- Benchmark ops
69-------------------------------------------------------------------------------
71{-# INLINE toNullAp #-}
72toNullAp
73 :: (S.IsStream t, S.MonadAsync m, Applicative (t m))
74 => (t m Int -> S.SerialT m Int) -> Int -> m ()
75toNullAp t start = runStream . t $
76 (+) <$> source start nestedCount2 <*> source start nestedCount2
78{-# INLINE toNull #-}
79toNull
80 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
81 => (t m Int -> S.SerialT m Int) -> Int -> m ()
82toNull t start = runStream . t $ do
83 x <- source start nestedCount2
84 y <- source start nestedCount2
85 return $ x + y
87{-# INLINE toNull3 #-}
88toNull3
89 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
90 => (t m Int -> S.SerialT m Int) -> Int -> m ()
91toNull3 t start = runStream . t $ do
92 x <- source start nestedCount3
93 y <- source start nestedCount3
94 z <- source start nestedCount3
95 return $ x + y + z
97{-# INLINE toList #-}
98toList
99 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
100 => (t m Int -> S.SerialT m Int) -> Int -> m [Int]
101toList t start = runToList . t $ do
102 x <- source start nestedCount2
103 y <- source start nestedCount2
104 return $ x + y
106{-# INLINE toListSome #-}
107toListSome
108 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
109 => (t m Int -> S.SerialT m Int) -> Int -> m [Int]
110toListSome t start =
111 runToList . t $ S.take 1000 $ do
112 x <- source start nestedCount2
113 y <- source start nestedCount2
114 return $ x + y
116{-# INLINE filterAllOut #-}
117filterAllOut
118 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
119 => (t m Int -> S.SerialT m Int) -> Int -> m ()
120filterAllOut 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
128{-# INLINE filterAllIn #-}
129filterAllIn
130 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
131 => (t m Int -> S.SerialT m Int) -> Int -> m ()
132filterAllIn t start = runStream . t $ do
133 x <- source start nestedCount2
134 y <- source start nestedCount2
135 let s = x + y
136 if s > 0
137 then return s
138 else S.nil
140{-# INLINE filterSome #-}
141filterSome
142 :: (S.IsStream t, S.MonadAsync m, Monad (t m))
143 => (t m Int -> S.SerialT m Int) -> Int -> m ()
144filterSome t start = runStream . t $ do
145 x <- source start nestedCount2
146 y <- source start nestedCount2
147 let s = x + y
148 if s > 1100000
149 then return s
150 else S.nil
152{-# INLINE breakAfterSome #-}
153breakAfterSome
154 :: (S.IsStream t, Monad (t IO))
155 => (t IO Int -> S.SerialT IO Int) -> Int -> IO ()
156breakAfterSome t start = do
157 (_ :: Either ErrorCall ()) <- try $ runStream . t $ do
158 x <- source start nestedCount2
159 y <- source start nestedCount2
160 let s = x + y
161 if s > 1100000
162 then error "break"
163 else return s
164 return ()