2018-04-09 18:02:49 +03:00
|
|
|
-- |
|
|
|
|
-- Module : BenchmarkOps
|
|
|
|
-- Copyright : (c) 2018 Harendra Kumar
|
|
|
|
--
|
|
|
|
-- License : MIT
|
|
|
|
-- Maintainer : harendra.kumar@gmail.com
|
|
|
|
|
2018-05-24 14:18:48 +03:00
|
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
|
|
|
2018-04-24 15:13:10 +03:00
|
|
|
module LinearOps where
|
2018-04-09 18:02:49 +03:00
|
|
|
|
|
|
|
import Prelude
|
2018-04-15 15:43:04 +03:00
|
|
|
(Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=),
|
2018-06-25 00:45:22 +03:00
|
|
|
subtract, undefined, Maybe(..), odd)
|
2018-04-09 18:02:49 +03:00
|
|
|
|
|
|
|
import qualified Streamly as S
|
|
|
|
import qualified Streamly.Prelude as S
|
|
|
|
|
2018-06-12 12:21:38 +03:00
|
|
|
value, maxValue :: Int
|
2018-05-30 06:50:08 +03:00
|
|
|
value = 100000
|
2018-04-09 18:02:49 +03:00
|
|
|
maxValue = value + 1000
|
|
|
|
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
-- Benchmark ops
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
|
|
|
|
{-# INLINE scan #-}
|
2018-06-25 01:21:02 +03:00
|
|
|
{-# INLINE mapM_ #-}
|
2018-04-09 18:02:49 +03:00
|
|
|
{-# INLINE map #-}
|
2018-06-24 20:13:30 +03:00
|
|
|
{-# INLINE fmap #-}
|
2018-06-25 01:21:02 +03:00
|
|
|
{-# INLINE mapMaybe #-}
|
2018-04-09 18:02:49 +03:00
|
|
|
{-# INLINE filterEven #-}
|
|
|
|
{-# INLINE filterAllOut #-}
|
|
|
|
{-# INLINE filterAllIn #-}
|
|
|
|
{-# INLINE takeOne #-}
|
|
|
|
{-# INLINE takeAll #-}
|
|
|
|
{-# INLINE takeWhileTrue #-}
|
2018-06-26 03:30:47 +03:00
|
|
|
{-# INLINE takeWhileMTrue #-}
|
2018-04-09 18:02:49 +03:00
|
|
|
{-# INLINE dropAll #-}
|
|
|
|
{-# INLINE dropWhileTrue #-}
|
2018-06-26 03:30:47 +03:00
|
|
|
{-# INLINE dropWhileMTrue #-}
|
2018-04-09 18:02:49 +03:00
|
|
|
{-# INLINE zip #-}
|
|
|
|
{-# INLINE concat #-}
|
|
|
|
{-# INLINE composeAllInFilters #-}
|
|
|
|
{-# INLINE composeAllOutFilters #-}
|
|
|
|
{-# INLINE composeMapAllInFilter #-}
|
2018-06-25 01:21:02 +03:00
|
|
|
scan, mapM_, map, fmap, mapMaybe, filterEven, filterAllOut,
|
2018-06-26 03:30:47 +03:00
|
|
|
filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropAll,
|
|
|
|
dropWhileTrue, dropWhileMTrue, zip,
|
2018-05-24 14:18:48 +03:00
|
|
|
concat, composeAllInFilters, composeAllOutFilters,
|
2018-04-09 18:02:49 +03:00
|
|
|
composeMapAllInFilter
|
|
|
|
:: Monad m
|
|
|
|
=> Stream m Int -> m ()
|
|
|
|
|
2018-06-18 00:26:52 +03:00
|
|
|
{-# INLINE composeMapM #-}
|
2018-06-25 01:21:02 +03:00
|
|
|
{-# INLINE zipAsync #-}
|
|
|
|
{-# INLINE mapMaybeM #-}
|
|
|
|
composeMapM, zipAsync, mapMaybeM :: S.MonadAsync m => Stream m Int -> m ()
|
2018-06-18 00:26:52 +03:00
|
|
|
|
|
|
|
{-# INLINE toList #-}
|
2018-06-24 20:13:30 +03:00
|
|
|
{-# INLINE foldr #-}
|
|
|
|
{-# INLINE foldrM #-}
|
|
|
|
toList, foldr, foldrM :: Monad m => Stream m Int -> m [Int]
|
2018-06-25 01:21:02 +03:00
|
|
|
|
2018-06-18 00:26:52 +03:00
|
|
|
{-# INLINE last #-}
|
2018-06-25 01:21:02 +03:00
|
|
|
{-# INLINE maximum #-}
|
|
|
|
{-# INLINE minimum #-}
|
|
|
|
last, minimum, maximum :: Monad m => Stream m Int -> m (Maybe Int)
|
|
|
|
|
|
|
|
{-# INLINE foldl #-}
|
|
|
|
{-# INLINE length #-}
|
|
|
|
{-# INLINE sum #-}
|
|
|
|
{-# INLINE product #-}
|
|
|
|
foldl, length, sum, product :: Monad m => Stream m Int -> m Int
|
|
|
|
|
2018-06-18 00:26:52 +03:00
|
|
|
{-# INLINE toNull #-}
|
2018-05-27 12:52:57 +03:00
|
|
|
toNull :: Monad m => (t m Int -> S.SerialT m Int) -> t m Int -> m ()
|
2018-06-25 01:21:02 +03:00
|
|
|
|
2018-06-18 00:26:52 +03:00
|
|
|
{-# INLINE mapM #-}
|
2018-06-09 18:41:15 +03:00
|
|
|
mapM :: (S.IsStream t, S.MonadAsync m)
|
|
|
|
=> (t m Int -> S.SerialT m Int) -> t m Int -> m ()
|
2018-06-25 01:21:02 +03:00
|
|
|
|
2018-06-25 00:45:22 +03:00
|
|
|
{-# INLINE sequence #-}
|
|
|
|
sequence :: (S.IsStream t, S.MonadAsync m)
|
|
|
|
=> (t m Int -> S.SerialT m Int) -> t m (m Int) -> m ()
|
2018-05-27 12:52:57 +03:00
|
|
|
|
2018-04-09 18:02:49 +03:00
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
-- Stream generation and elimination
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
|
2018-05-13 07:57:49 +03:00
|
|
|
type Stream m a = S.SerialT m a
|
2018-04-09 18:02:49 +03:00
|
|
|
|
2018-05-21 15:24:19 +03:00
|
|
|
{-# INLINE source #-}
|
2018-06-09 18:41:15 +03:00
|
|
|
source :: (S.MonadAsync m, S.IsStream t) => Int -> t m Int
|
|
|
|
source n = S.serially $ sourceUnfoldrM n
|
2018-06-24 20:13:30 +03:00
|
|
|
-- source n = S.serially $ sourceFromList n
|
2018-05-21 15:24:19 +03:00
|
|
|
|
2018-06-24 03:49:41 +03:00
|
|
|
{-# INLINE sourceFromList #-}
|
|
|
|
sourceFromList :: (Monad m, S.IsStream t) => Int -> t m Int
|
|
|
|
sourceFromList n = S.fromList [n..n+value]
|
|
|
|
|
|
|
|
{-# INLINE sourceFromListM #-}
|
|
|
|
sourceFromListM :: (S.MonadAsync m, S.IsStream t) => Int -> t m Int
|
|
|
|
sourceFromListM n = S.fromListM (Prelude.fmap return [n..n+value])
|
|
|
|
|
2018-05-27 12:52:57 +03:00
|
|
|
{-# INLINE sourceFromFoldable #-}
|
|
|
|
sourceFromFoldable :: S.IsStream t => Int -> t m Int
|
2018-05-21 15:24:19 +03:00
|
|
|
sourceFromFoldable n = S.fromFoldable [n..n+value]
|
|
|
|
|
|
|
|
{-# INLINE sourceFromFoldableM #-}
|
2018-05-27 12:52:57 +03:00
|
|
|
sourceFromFoldableM :: (S.IsStream t, S.MonadAsync m) => Int -> t m Int
|
2018-05-21 15:24:19 +03:00
|
|
|
sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])
|
|
|
|
|
2018-05-27 12:52:57 +03:00
|
|
|
{-# INLINE sourceFoldMapWith #-}
|
|
|
|
sourceFoldMapWith :: (S.IsStream t, Monad (t m), S.Semigroup (t m Int))
|
|
|
|
=> Int -> t m Int
|
|
|
|
sourceFoldMapWith n = S.foldMapWith (S.<>) return [n..n+value]
|
|
|
|
|
|
|
|
{-# INLINE sourceFoldMapWithM #-}
|
|
|
|
sourceFoldMapWithM :: (S.IsStream t, Monad m, S.Semigroup (t m Int))
|
|
|
|
=> Int -> t m Int
|
2018-06-23 04:20:59 +03:00
|
|
|
sourceFoldMapWithM n = S.foldMapWith (S.<>) (S.yieldM . return) [n..n+value]
|
2018-05-21 15:24:19 +03:00
|
|
|
|
2018-06-09 18:41:15 +03:00
|
|
|
{-# INLINE sourceUnfoldr #-}
|
2018-06-24 03:49:41 +03:00
|
|
|
sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> t m Int
|
2018-06-09 18:41:15 +03:00
|
|
|
sourceUnfoldr n = S.unfoldr step n
|
|
|
|
where
|
|
|
|
step cnt =
|
|
|
|
if cnt > n + value
|
|
|
|
then Nothing
|
|
|
|
else (Just (cnt, cnt + 1))
|
|
|
|
|
2018-05-21 15:24:19 +03:00
|
|
|
{-# INLINE sourceUnfoldrM #-}
|
2018-05-27 12:52:57 +03:00
|
|
|
sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> t m Int
|
2018-05-21 15:24:19 +03:00
|
|
|
sourceUnfoldrM n = S.unfoldrM step n
|
|
|
|
where
|
|
|
|
step cnt =
|
|
|
|
if cnt > n + value
|
|
|
|
then return Nothing
|
|
|
|
else return (Just (cnt, cnt + 1))
|
2018-04-09 18:02:49 +03:00
|
|
|
|
2018-06-25 00:45:22 +03:00
|
|
|
{-# INLINE sourceUnfoldrMAction #-}
|
|
|
|
sourceUnfoldrMAction :: (S.IsStream t, S.MonadAsync m) => Int -> t m (m Int)
|
|
|
|
sourceUnfoldrMAction n = S.serially $ S.unfoldrM step n
|
|
|
|
where
|
|
|
|
step cnt =
|
|
|
|
if cnt > n + value
|
|
|
|
then return Nothing
|
|
|
|
else return (Just (return cnt, cnt + 1))
|
2018-04-09 18:02:49 +03:00
|
|
|
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
-- Elimination
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
|
2018-06-25 00:45:22 +03:00
|
|
|
{-# INLINE runStream #-}
|
|
|
|
runStream :: Monad m => Stream m a -> m ()
|
|
|
|
runStream = S.runStream
|
|
|
|
|
2018-05-27 12:52:57 +03:00
|
|
|
toNull t = runStream . t
|
2018-06-24 20:13:30 +03:00
|
|
|
mapM_ = S.mapM_ (\_ -> return ())
|
2018-04-09 18:02:49 +03:00
|
|
|
toList = S.toList
|
2018-06-24 20:13:30 +03:00
|
|
|
foldr = S.foldr (:) []
|
|
|
|
foldrM = S.foldrM (\a xs -> return (a : xs)) []
|
2018-04-15 15:43:04 +03:00
|
|
|
foldl = S.foldl' (+) 0
|
2018-04-09 18:02:49 +03:00
|
|
|
last = S.last
|
2018-06-25 01:21:02 +03:00
|
|
|
length = S.length
|
|
|
|
sum = S.sum
|
|
|
|
product = S.product
|
|
|
|
maximum = S.maximum
|
|
|
|
minimum = S.minimum
|
2018-04-09 18:02:49 +03:00
|
|
|
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
-- Transformation
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
|
|
|
|
{-# INLINE transform #-}
|
|
|
|
transform :: Monad m => Stream m a -> m ()
|
|
|
|
transform = runStream
|
|
|
|
|
2018-04-15 15:43:04 +03:00
|
|
|
scan = transform . S.scanl' (+) 0
|
2018-06-24 20:13:30 +03:00
|
|
|
fmap = transform . Prelude.fmap (+1)
|
|
|
|
map = transform . S.map (+1)
|
2018-06-09 18:41:15 +03:00
|
|
|
mapM t = transform . t . S.mapM return
|
2018-06-25 00:45:22 +03:00
|
|
|
mapMaybe = transform . S.mapMaybe
|
|
|
|
(\x -> if Prelude.odd x then Nothing else Just ())
|
|
|
|
mapMaybeM = transform . S.mapMaybeM
|
|
|
|
(\x -> if Prelude.odd x then (return Nothing) else return $ Just ())
|
|
|
|
sequence t = transform . t . S.sequence
|
2018-04-09 18:02:49 +03:00
|
|
|
filterEven = transform . S.filter even
|
|
|
|
filterAllOut = transform . S.filter (> maxValue)
|
|
|
|
filterAllIn = transform . S.filter (<= maxValue)
|
|
|
|
takeOne = transform . S.take 1
|
|
|
|
takeAll = transform . S.take maxValue
|
|
|
|
takeWhileTrue = transform . S.takeWhile (<= maxValue)
|
2018-06-26 03:30:47 +03:00
|
|
|
takeWhileMTrue = transform . S.takeWhileM (return . (<= maxValue))
|
2018-04-09 18:02:49 +03:00
|
|
|
dropAll = transform . S.drop maxValue
|
|
|
|
dropWhileTrue = transform . S.dropWhile (<= maxValue)
|
2018-06-26 03:30:47 +03:00
|
|
|
dropWhileMTrue = transform . S.dropWhileM (return . (<= maxValue))
|
2018-04-09 18:02:49 +03:00
|
|
|
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
-- Zipping and concat
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
|
|
|
|
zip src = transform $ (S.zipWith (,) src src)
|
2018-06-09 18:41:15 +03:00
|
|
|
zipAsync src = transform $ (S.zipAsyncWith (,) src src)
|
2018-04-09 18:02:49 +03:00
|
|
|
concat _n = return ()
|
|
|
|
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
-- Composition
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
|
|
|
|
{-# INLINE compose #-}
|
|
|
|
compose :: Monad m => (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
|
|
|
|
compose f = transform . f . f . f . f
|
|
|
|
|
|
|
|
composeMapM = compose (S.mapM return)
|
|
|
|
composeAllInFilters = compose (S.filter (<= maxValue))
|
|
|
|
composeAllOutFilters = compose (S.filter (> maxValue))
|
2018-06-24 20:13:30 +03:00
|
|
|
composeMapAllInFilter =
|
|
|
|
compose (S.filter (<= maxValue) . Prelude.fmap (subtract 1))
|
2018-04-09 18:02:49 +03:00
|
|
|
|
2018-05-27 08:03:21 +03:00
|
|
|
{-# INLINABLE composeScaling #-}
|
2018-04-09 18:02:49 +03:00
|
|
|
composeScaling :: Monad m => Int -> Stream m Int -> m ()
|
|
|
|
composeScaling m =
|
|
|
|
case m of
|
|
|
|
1 -> transform . f
|
|
|
|
2 -> transform . f . f
|
|
|
|
3 -> transform . f . f . f
|
|
|
|
4 -> transform . f . f . f . f
|
|
|
|
_ -> undefined
|
|
|
|
where f = S.filter (<= maxValue)
|