@@ -0,0 +1,154 @@
1+-- |
2+-- Module : BenchmarkOps
3+-- Copyright : (c) 2018 Harendra Kumar
4+--
5+-- License : MIT
6+-- Maintainer : harendra.kumar@gmail.com
7+
8+{-# LANGUAGE ScopedTypeVariables #-}
9+
10+module BenchmarkNestedLoopOps where
11+
12+import Control.Exception (try)
13+import GHC.Exception (ErrorCall)
14+
15+import qualified Streamly as S
16+import qualified Streamly.Prelude as S
17+
18+sumCount :: Int
19+sumCount = 1000000
20+
21+prodCount :: Int
22+prodCount = 1000
23+
24+-------------------------------------------------------------------------------
25+-- Stream generation and elimination
26+-------------------------------------------------------------------------------
27+
28+type Stream m a = S.SerialT m a
29+
30+{-# INLINE source #-}
31+source :: S.IsStream t => Int -> Int -> t m Int
32+source start n = S.fromFoldable [start..start+n]
33+
34+{-# INLINE runStream #-}
35+runStream :: Monad m => Stream m a -> m ()
36+runStream = S.runStream
37+
38+{-# INLINE runToList #-}
39+runToList :: Monad m => Stream m a -> m [a]
40+runToList = S.toList
41+
42+-------------------------------------------------------------------------------
43+-- Benchmark ops
44+-------------------------------------------------------------------------------
45+
46+{-# INLINE toNullLinear #-}
47+toNullLinear :: Monad m => Int -> m ()
48+toNullLinear start = runStream $ source start sumCount
49+
50+{-# INLINE toListLinear #-}
51+toListLinear :: Monad m => Int -> m [Int]
52+toListLinear start = runToList $ source start sumCount
53+
54+{-# INLINE append #-}
55+append
56+ :: (Monoid (t m Int), Monad m, Monad (t m))
57+ => (t m Int -> S.SerialT m Int) -> Int -> m ()
58+append t start = runStream $ t $ foldMap return [start..start+sumCount]
59+
60+{-# INLINE toNull0 #-}
61+toNull0
62+ :: (S.IsStream t, Monad m, Monad (t m))
63+ => (t m (Int, Int) -> S.SerialT m (Int, Int)) -> Int -> m ()
64+toNull0 t start = runStream . t $ do
65+ x <- source start prodCount
66+ y <- source start prodCount
67+ return (x,y)
68+
69+{-# INLINE toList0 #-}
70+toList0
71+ :: (S.IsStream t, Monad m, Monad (t m))
72+ => (t m (Int, Int) -> S.SerialT m (Int, Int)) -> Int -> m [(Int, Int)]
73+toList0 t start = runToList . t $ do
74+ x <- source start prodCount
75+ y <- source start prodCount
76+ return (x,y)
77+
78+{-# INLINE toNull #-}
79+toNull
80+ :: (S.IsStream t, Monad m, Monad (t m))
81+ => (t m Int -> S.SerialT m Int) -> Int -> m ()
82+toNull t start = runStream . t $ do
83+ x <- source start prodCount
84+ y <- source start prodCount
85+ return $ x * x + y * y
86+
87+{-# INLINE toList #-}
88+toList
89+ :: (S.IsStream t, Monad m, Monad (t m))
90+ => (t m Int -> S.SerialT m Int) -> Int -> m [Int]
91+toList t start = runToList . t $ do
92+ x <- source start prodCount
93+ y <- source start prodCount
94+ return $ x * x + y * y
95+
96+{-# INLINE toListSome #-}
97+toListSome
98+ :: (S.IsStream t, Monad m, Monad (t m))
99+ => (t m Int -> S.SerialT m Int) -> Int -> m [Int]
100+toListSome t start =
101+ runToList . t $ S.take 1000 $ do
102+ x <- source start prodCount
103+ y <- source start prodCount
104+ return $ x * x + y * y
105+
106+{-# INLINE filterAllOut #-}
107+filterAllOut
108+ :: (S.IsStream t, Monad m, Monad (t m))
109+ => (t m Int -> S.SerialT m Int) -> Int -> m ()
110+filterAllOut t start = runStream . t $ do
111+ x <- source start prodCount
112+ y <- source start prodCount
113+ let s = x * x + y * y
114+ if (s < 1)
115+ then return s
116+ else S.nil
117+
118+{-# INLINE filterAllIn #-}
119+filterAllIn
120+ :: (S.IsStream t, Monad m, Monad (t m))
121+ => (t m Int -> S.SerialT m Int) -> Int -> m ()
122+filterAllIn t start = runStream . t $ do
123+ x <- source start prodCount
124+ y <- source start prodCount
125+ let s = x * x + y * y
126+ if (s > 1)
127+ then return s
128+ else S.nil
129+
130+{-# INLINE filterSome #-}
131+filterSome
132+ :: (S.IsStream t, Monad m, Monad (t m))
133+ => (t m Int -> S.SerialT m Int) -> Int -> m ()
134+filterSome t start = runStream . t $ do
135+ x <- source start prodCount
136+ y <- source start prodCount
137+ let s = x * x + y * y
138+ if (s > 1100000)
139+ then return s
140+ else S.nil
141+
142+{-# INLINE breakAfterSome #-}
143+breakAfterSome
144+ :: (S.IsStream t, Monad (t IO))
145+ => (t IO Int -> S.SerialT IO Int) -> Int -> IO ()
146+breakAfterSome t start = do
147+ (_ :: Either ErrorCall ()) <- try $ runStream . t $ do
148+ x <- source start prodCount
149+ y <- source start prodCount
150+ let s = x * x + y * y
151+ if (s > 1100000)
152+ then error "break"
153+ else return s
154+ return ()