@@ -0,0 +1,424 @@
1+-- |
2+-- Module : StreamDKOps
3+-- Copyright : (c) 2018 Harendra Kumar
4+--
5+-- License : BSD3
6+-- Maintainer : harendra.kumar@gmail.com
7+
8+{-# LANGUAGE FlexibleContexts #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
10+
11+module StreamDKOps where
12+
13+-- import Control.Monad (when)
14+-- import Data.Maybe (isJust)
15+import Prelude
16+ (Monad, Int, (+), ($), (.), return, even, (>), (<=), div,
17+ subtract, undefined, Maybe(..), not, (>>=),
18+ maxBound, flip, (<$>), (<*>), round, (/), (**), (<))
19+import qualified Prelude as P
20+-- import qualified Data.List as List
21+
22+import qualified Streamly.Streams.StreamDK as S
23+-- import qualified Streamly.Streams.Prelude as SP
24+-- import qualified Streamly.SVar as S
25+
26+value, value2, value3, value16, maxValue :: Int
27+value = 100000
28+value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop
29+value3 = round (P.fromIntegral value**(1/3::P.Double)) -- triple nested loop
30+value16 = round (P.fromIntegral value**(1/16::P.Double)) -- triple nested loop
31+maxValue = value
32+
33+-------------------------------------------------------------------------------
34+-- Benchmark ops
35+-------------------------------------------------------------------------------
36+
37+-------------------------------------------------------------------------------
38+-- Stream generation and elimination
39+-------------------------------------------------------------------------------
40+
41+type Stream m a = S.Stream m a
42+
43+{-# INLINE sourceUnfoldr #-}
44+sourceUnfoldr :: Monad m => Int -> Stream m Int
45+sourceUnfoldr n = S.unfoldr step n
46+ where
47+ step cnt =
48+ if cnt > n + value
49+ then Nothing
50+ else Just (cnt, cnt + 1)
51+
52+{-# INLINE sourceUnfoldrN #-}
53+sourceUnfoldrN :: Monad m => Int -> Int -> Stream m Int
54+sourceUnfoldrN m n = S.unfoldr step n
55+ where
56+ step cnt =
57+ if cnt > n + m
58+ then Nothing
59+ else Just (cnt, cnt + 1)
60+
61+{-# INLINE sourceUnfoldrM #-}
62+sourceUnfoldrM :: Monad m => Int -> Stream m Int
63+sourceUnfoldrM n = S.unfoldrM step n
64+ where
65+ step cnt =
66+ if cnt > n + value
67+ then return Nothing
68+ else return (Just (cnt, cnt + 1))
69+
70+{-# INLINE sourceUnfoldrMN #-}
71+sourceUnfoldrMN :: Monad m => Int -> Int -> Stream m Int
72+sourceUnfoldrMN m n = S.unfoldrM step n
73+ where
74+ step cnt =
75+ if cnt > n + m
76+ then return Nothing
77+ else return (Just (cnt, cnt + 1))
78+
79+{-
80+{-# INLINE sourceFromEnum #-}
81+sourceFromEnum :: Monad m => Int -> Stream m Int
82+sourceFromEnum n = S.enumFromStepN n 1 value
83+-}
84+
85+{-
86+{-# INLINE sourceFromFoldable #-}
87+sourceFromFoldable :: Int -> Stream m Int
88+sourceFromFoldable n = S.fromFoldable [n..n+value]
89+-}
90+
91+{-
92+{-# INLINE sourceFromFoldableM #-}
93+sourceFromFoldableM :: S.MonadAsync m => Int -> Stream m Int
94+sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])
95+-}
96+
97+{-
98+{-# INLINE sourceFoldMapWith #-}
99+sourceFoldMapWith :: Int -> Stream m Int
100+sourceFoldMapWith n = SP.foldMapWith S.serial S.yield [n..n+value]
101+
102+{-# INLINE sourceFoldMapWithM #-}
103+sourceFoldMapWithM :: Monad m => Int -> Stream m Int
104+sourceFoldMapWithM n = SP.foldMapWith S.serial (S.yieldM . return) [n..n+value]
105+-}
106+
107+{-# INLINE source #-}
108+source :: Monad m => Int -> Stream m Int
109+source = sourceUnfoldrM
110+
111+-------------------------------------------------------------------------------
112+-- Elimination
113+-------------------------------------------------------------------------------
114+
115+{-# INLINE runStream #-}
116+runStream :: Monad m => Stream m a -> m ()
117+runStream = S.drain
118+-- runStream = S.mapM_ (\_ -> return ())
119+
120+{-
121+{-# INLINE mapM_ #-}
122+mapM_ :: Monad m => Stream m a -> m ()
123+mapM_ = S.mapM_ (\_ -> return ())
124+-}
125+
126+{-# INLINE toNull #-}
127+toNull :: Monad m => Stream m Int -> m ()
128+toNull = runStream
129+
130+{-# INLINE uncons #-}
131+uncons :: Monad m => Stream m Int -> m ()
132+uncons s = do
133+ r <- S.uncons s
134+ case r of
135+ Nothing -> return ()
136+ Just (_, t) -> uncons t
137+
138+{-
139+{-# INLINE init #-}
140+init :: (Monad m, S.IsStream t) => t m a -> m ()
141+init s = do
142+ t <- S.init s
143+ P.mapM_ S.drain t
144+
145+{-# INLINE tail #-}
146+tail :: (Monad m, S.IsStream t) => t m a -> m ()
147+tail s = S.tail s >>= P.mapM_ tail
148+
149+{-# INLINE nullTail #-}
150+{-# INLINE headTail #-}
151+{-# INLINE zip #-}
152+nullTail, headTail, zip
153+ :: Monad m
154+ => Stream m Int -> m ()
155+
156+nullTail s = do
157+ r <- S.null s
158+ when (not r) $ S.tail s >>= P.mapM_ nullTail
159+
160+headTail s = do
161+ h <- S.head s
162+ when (isJust h) $ S.tail s >>= P.mapM_ headTail
163+
164+{-# INLINE toList #-}
165+toList :: Monad m => Stream m Int -> m [Int]
166+toList = S.toList
167+
168+{-# INLINE foldl #-}
169+foldl :: Monad m => Stream m Int -> m Int
170+foldl = S.foldl' (+) 0
171+
172+{-# INLINE last #-}
173+last :: Monad m => Stream m Int -> m (Maybe Int)
174+last = S.last
175+-}
176+
177+-------------------------------------------------------------------------------
178+-- Transformation
179+-------------------------------------------------------------------------------
180+
181+{-# INLINE transform #-}
182+transform :: Monad m => Stream m a -> m ()
183+transform = runStream
184+
185+{-# INLINE composeN #-}
186+composeN
187+ :: Monad m
188+ => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
189+composeN n f =
190+ case n of
191+ 1 -> transform . f
192+ 2 -> transform . f . f
193+ 3 -> transform . f . f . f
194+ 4 -> transform . f . f . f . f
195+ _ -> undefined
196+
197+{-
198+{-# INLINE scan #-}
199+{-# INLINE map #-}
200+{-# INLINE fmap #-}
201+{-# INLINE filterEven #-}
202+{-# INLINE filterAllOut #-}
203+{-# INLINE filterAllIn #-}
204+{-# INLINE takeOne #-}
205+{-# INLINE takeAll #-}
206+{-# INLINE takeWhileTrue #-}
207+{-# INLINE dropOne #-}
208+{-# INLINE dropAll #-}
209+{-# INLINE dropWhileTrue #-}
210+{-# INLINE dropWhileFalse #-}
211+{-# INLINE foldlS #-}
212+{-# INLINE concatMap #-}
213+scan, map, fmap, filterEven, filterAllOut,
214+ filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropOne,
215+ dropWhileTrue, dropWhileFalse, foldlS, concatMap
216+ :: Monad m
217+ => Int -> Stream m Int -> m ()
218+
219+{-# INLINE mapM #-}
220+{-# INLINE mapMSerial #-}
221+{-# INLINE intersperse #-}
222+mapM, mapMSerial, intersperse
223+ :: S.MonadAsync m => Int -> Stream m Int -> m ()
224+
225+scan n = composeN n $ S.scanl' (+) 0
226+map n = composeN n $ P.fmap (+1)
227+fmap n = composeN n $ P.fmap (+1)
228+mapM n = composeN n $ S.mapM return
229+mapMSerial n = composeN n $ S.mapMSerial return
230+filterEven n = composeN n $ S.filter even
231+filterAllOut n = composeN n $ S.filter (> maxValue)
232+filterAllIn n = composeN n $ S.filter (<= maxValue)
233+takeOne n = composeN n $ S.take 1
234+takeAll n = composeN n $ S.take maxValue
235+takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)
236+dropOne n = composeN n $ S.drop 1
237+dropAll n = composeN n $ S.drop maxValue
238+dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)
239+dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
240+foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
241+-- We use a (sqrt n) element stream as source and then concat the same stream
242+-- for each element to produce an n element stream.
243+concatMap n = composeN n $ (\s -> S.concatMap (\_ -> s) s)
244+intersperse n = composeN n $ S.intersperse maxValue
245+
246+-------------------------------------------------------------------------------
247+-- Iteration
248+-------------------------------------------------------------------------------
249+
250+iterStreamLen, maxIters :: Int
251+iterStreamLen = 10
252+maxIters = 10000
253+
254+{-# INLINE iterateSource #-}
255+iterateSource
256+ :: S.MonadAsync m
257+ => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
258+iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)
259+ where
260+ f (0 :: Int) m = g m
261+ f x m = g (f (x P.- 1) m)
262+
263+{-# INLINE iterateMapM #-}
264+{-# INLINE iterateScan #-}
265+{-# INLINE iterateFilterEven #-}
266+{-# INLINE iterateTakeAll #-}
267+{-# INLINE iterateDropOne #-}
268+{-# INLINE iterateDropWhileFalse #-}
269+{-# INLINE iterateDropWhileTrue #-}
270+iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,
271+ iterateDropWhileFalse, iterateDropWhileTrue
272+ :: S.MonadAsync m
273+ => Int -> Stream m Int
274+
275+-- this is quadratic
276+iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)
277+iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue))
278+ (maxIters `div` 10)
279+
280+iterateMapM = iterateSource (S.mapM return) maxIters
281+iterateFilterEven = iterateSource (S.filter even) maxIters
282+iterateTakeAll = iterateSource (S.take maxValue) maxIters
283+iterateDropOne = iterateSource (S.drop 1) maxIters
284+iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
285+
286+-------------------------------------------------------------------------------
287+-- Zipping and concat
288+-------------------------------------------------------------------------------
289+
290+zip src = transform $ S.zipWith (,) src src
291+
292+{-# INLINE concatMapRepl4xN #-}
293+concatMapRepl4xN :: Monad m => Stream m Int -> m ()
294+concatMapRepl4xN src = transform $ (S.concatMap (S.replicate 4) src)
295+
296+-------------------------------------------------------------------------------
297+-- Mixed Composition
298+-------------------------------------------------------------------------------
299+
300+{-# INLINE scanMap #-}
301+{-# INLINE dropMap #-}
302+{-# INLINE dropScan #-}
303+{-# INLINE takeDrop #-}
304+{-# INLINE takeScan #-}
305+{-# INLINE takeMap #-}
306+{-# INLINE filterDrop #-}
307+{-# INLINE filterTake #-}
308+{-# INLINE filterScan #-}
309+{-# INLINE filterMap #-}
310+scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,
311+ filterTake, filterScan, filterMap
312+ :: Monad m => Int -> Stream m Int -> m ()
313+
314+scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
315+dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
316+dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
317+takeDrop n = composeN n $ S.drop 1 . S.take maxValue
318+takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue
319+takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue
320+filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)
321+filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
322+filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
323+filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
324+
325+-------------------------------------------------------------------------------
326+-- Nested Composition
327+-------------------------------------------------------------------------------
328+
329+{-# INLINE toNullApNested #-}
330+toNullApNested :: Monad m => Stream m Int -> m ()
331+toNullApNested s = runStream $ do
332+ (+) <$> s <*> s
333+
334+{-# INLINE toNullNested #-}
335+toNullNested :: Monad m => Stream m Int -> m ()
336+toNullNested s = runStream $ do
337+ x <- s
338+ y <- s
339+ return $ x + y
340+
341+{-# INLINE toNullNested3 #-}
342+toNullNested3 :: Monad m => Stream m Int -> m ()
343+toNullNested3 s = runStream $ do
344+ x <- s
345+ y <- s
346+ z <- s
347+ return $ x + y + z
348+
349+{-# INLINE filterAllOutNested #-}
350+filterAllOutNested
351+ :: Monad m
352+ => Stream m Int -> m ()
353+filterAllOutNested str = runStream $ do
354+ x <- str
355+ y <- str
356+ let s = x + y
357+ if s < 0
358+ then return s
359+ else S.nil
360+
361+{-# INLINE filterAllInNested #-}
362+filterAllInNested
363+ :: Monad m
364+ => Stream m Int -> m ()
365+filterAllInNested str = runStream $ do
366+ x <- str
367+ y <- str
368+ let s = x + y
369+ if s > 0
370+ then return s
371+ else S.nil
372+
373+-------------------------------------------------------------------------------
374+-- Nested Composition Pure lists
375+-------------------------------------------------------------------------------
376+
377+{-# INLINE sourceUnfoldrList #-}
378+sourceUnfoldrList :: Int -> Int -> [Int]
379+sourceUnfoldrList maxval n = List.unfoldr step n
380+ where
381+ step cnt =
382+ if cnt > n + maxval
383+ then Nothing
384+ else Just (cnt, cnt + 1)
385+
386+{-# INLINE toNullApNestedList #-}
387+toNullApNestedList :: [Int] -> [Int]
388+toNullApNestedList s = (+) <$> s <*> s
389+
390+{-# INLINE toNullNestedList #-}
391+toNullNestedList :: [Int] -> [Int]
392+toNullNestedList s = do
393+ x <- s
394+ y <- s
395+ return $ x + y
396+
397+{-# INLINE toNullNestedList3 #-}
398+toNullNestedList3 :: [Int] -> [Int]
399+toNullNestedList3 s = do
400+ x <- s
401+ y <- s
402+ z <- s
403+ return $ x + y + z
404+
405+{-# INLINE filterAllOutNestedList #-}
406+filterAllOutNestedList :: [Int] -> [Int]
407+filterAllOutNestedList str = do
408+ x <- str
409+ y <- str
410+ let s = x + y
411+ if s < 0
412+ then return s
413+ else []
414+
415+{-# INLINE filterAllInNestedList #-}
416+filterAllInNestedList :: [Int] -> [Int]
417+filterAllInNestedList str = do
418+ x <- str
419+ y <- str
420+ let s = x + y
421+ if s > 0
422+ then return s
423+ else []
424+-}