-- |
-- Module : Benchmarks.StreamlyArray
-- Copyright : (c) 2018 Harendra Kumar
--
-- License : MIT
-- Maintainer : harendra.kumar@gmail.com
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Benchmarks.StreamlyArray where
import Control.DeepSeq (NFData(..))
import Control.Monad.IO.Class (MonadIO(..))
import Prelude (Int, (+), ($), (.), even, (>), (<=), subtract, undefined,
maxBound, Maybe(..), fmap, div)
import qualified Prelude as P
import Benchmarks.DefaultMain (defaultMain)
import Benchmarks.Common (value, maxValue) -- , appendValue)
import qualified Streamly.Data.Stream as S
import qualified Streamly.Data.Array as A
import qualified Streamly.Data.Fold as Fold
import qualified Streamly.Data.Scanl as Scanl
instance NFData (A.Array a) where
{-# INLINE rnf #-}
rnf _ = ()
-------------------------------------------------------------------------------
-- Stream generation and elimination
-------------------------------------------------------------------------------
type Stream = A.Array
{-# INLINE source #-}
source :: MonadIO m => Int -> m (Stream Int)
source n = S.fold (A.createOf value) (S.unfoldr step n)
where
step cnt =
if cnt > n + value
then Nothing
else (Just (cnt, cnt + 1))
{-# INLINE sourceN #-}
sourceN :: MonadIO m => Int -> Int -> m (Stream Int)
sourceN count begin = S.fold (A.createOf value) (S.unfoldr step begin)
where
step i =
if i > begin + count
then Nothing
else (Just (i, i + 1))
-------------------------------------------------------------------------------
-- Append
-------------------------------------------------------------------------------
{-
{-# INLINE appendSourceR #-}
appendSourceR :: Int -> Stream Int
appendSourceR n =
P.foldr (S.++) S.empty (P.map S.singleton [n..n+appendValue])
{-# INLINE appendSourceL #-}
appendSourceL :: Int -> Stream Int
appendSourceL n = P.foldl (S.++) S.empty (P.map S.singleton [n..n+appendValue])
-}
-------------------------------------------------------------------------------
-- Elimination
-------------------------------------------------------------------------------
{-# INLINE toNull #-}
toNull :: P.Monad m => Stream Int -> m (Stream Int)
toNull = P.return
{-# INLINE toList #-}
toList :: P.Monad m => Stream Int -> m ([Int])
toList = P.return . A.toList
{-# INLINE foldl #-}
foldl :: MonadIO m => Stream Int -> m Int
foldl = S.fold Fold.sum . S.unfold A.reader
{-# INLINE last #-}
last :: P.Monad m => Stream Int -> m (Maybe Int)
last arr = P.return (A.getIndex (A.length arr P.- 1) arr)
-------------------------------------------------------------------------------
-- Transformation
-------------------------------------------------------------------------------
{-
{-# INLINE transform #-}
transform :: Stream a -> ()
transform = eval
-}
{-# INLINE composeN #-}
composeN
:: MonadIO m
=> Int
-> (S.Stream m Int -> S.Stream m Int)
-> Stream Int
-> m (Stream Int)
composeN n f x =
case n of
1 -> S.fold A.create $ f $ S.unfold A.reader x
2 -> S.fold A.create $ f . f $ S.unfold A.reader x
3 -> S.fold A.create $ f . f . f $ S.unfold A.reader x
4 -> S.fold A.create $ f . f . f . f $ S.unfold A.reader x
_ -> undefined
{-# INLINE scan #-}
{-# INLINE map #-}
{-# INLINE mapM #-}
{-# INLINE filterEven #-}
{-# INLINE filterAllOut #-}
{-# INLINE filterAllIn #-}
{-# INLINE takeOne #-}
{-# INLINE takeAll #-}
{-# INLINE takeWhileTrue #-}
{-# INLINE dropOne #-}
{-# INLINE dropAll #-}
{-# INLINE dropWhileTrue #-}
{-# INLINE dropWhileFalse #-}
scan, map, mapM,
filterEven, filterAllOut, filterAllIn,
takeOne, takeAll, takeWhileTrue,
dropOne, dropAll, dropWhileTrue, dropWhileFalse
:: MonadIO m => Int -> Stream Int -> m (Stream Int)
scan n = composeN n $ S.scanl (Scanl.mkScanl (+) 0)
map n = composeN n $ fmap (+1)
mapM n = composeN n $ S.mapM (\x -> P.return $ x + 1)
filterEven n = composeN n $ S.filter even
filterAllOut n = composeN n $ S.filter (> maxValue)
filterAllIn n = composeN n $ S.filter (<= maxValue)
takeOne n = composeN n $ S.take 1
takeAll n = composeN n $ S.take maxValue
takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)
dropOne n = composeN n $ S.drop 1
dropAll n = composeN n $ S.drop maxValue
dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)
dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)
-------------------------------------------------------------------------------
-- Iteration
-------------------------------------------------------------------------------
iterStreamLen, maxIters :: Int
iterStreamLen = 10
maxIters = 100000
{-# INLINE iterateSource #-}
iterateSource :: MonadIO m
=> (S.Stream m Int -> S.Stream m Int) -> Int -> Int -> m (Stream Int)
iterateSource g i n =
sourceN iterStreamLen n P.>>= \a -> S.fold A.create (f i $ S.unfold A.reader a)
where
f (0 :: Int) m = g m
f x m = g (f (x P.- 1) m)
{-# INLINE iterateMapM #-}
{-# INLINE iterateScan #-}
{-# INLINE iterateFilterEven #-}
{-# INLINE iterateTakeAll #-}
{-# INLINE iterateDropOne #-}
{-# INLINE iterateDropWhileFalse #-}
{-# INLINE iterateDropWhileTrue #-}
iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,
iterateDropWhileFalse, iterateDropWhileTrue ::
MonadIO m => Int -> m (Stream Int)
-- Scan increases the size of the stream by 1, drop 1 to not blow up the size
-- due to many iterations.
iterateScan n = iterateSource (S.drop 1 . S.scanl (Scanl.mkScanl (+) 0)) (maxIters `div` 100) n
iterateMapM n = iterateSource (S.mapM P.return) maxIters n
iterateFilterEven n = iterateSource (S.filter even) maxIters n
iterateTakeAll n = iterateSource (S.take maxValue) maxIters n
iterateDropOne n = iterateSource (S.drop 1) maxIters n
iterateDropWhileFalse n = iterateSource (S.dropWhile (> maxValue)) (maxIters `div` 100) n
iterateDropWhileTrue n = iterateSource (S.dropWhile (<= maxValue)) maxIters n
-------------------------------------------------------------------------------
-- Mixed Composition
-------------------------------------------------------------------------------
{-# INLINE scanMap #-}
{-# INLINE dropMap #-}
{-# INLINE dropScan #-}
{-# INLINE takeDrop #-}
{-# INLINE takeScan #-}
{-# INLINE takeMap #-}
{-# INLINE filterDrop #-}
{-# INLINE filterTake #-}
{-# INLINE filterScan #-}
{-# INLINE filterMap #-}
scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,
filterTake, filterScan, filterMap
:: MonadIO m => Int -> Stream Int -> m (Stream Int)
scanMap n = composeN n $ fmap (subtract 1) . S.scanl (Scanl.mkScanl (+) 0)
dropMap n = composeN n $ fmap (subtract 1) . S.drop 1
dropScan n = composeN n $ S.scanl (Scanl.mkScanl (+) 0) . S.drop 1
takeDrop n = composeN n $ S.drop 1 . S.take maxValue
takeScan n = composeN n $ S.scanl (Scanl.mkScanl (+) 0) . S.take maxValue
takeMap n = composeN n $ fmap (subtract 1) . S.take maxValue
filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)
filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
filterScan n = composeN n $ S.scanl (Scanl.mkScanl (+) 0) . S.filter (<= maxBound)
filterMap n = composeN n $ fmap (subtract 1) . S.filter (<= maxValue)
-------------------------------------------------------------------------------
-- Zipping and concat
-------------------------------------------------------------------------------
{-
{-# INLINE zip #-}
zip :: Stream Int -> ()
zip src = P.foldr (\(x,y) xs -> P.seq x (P.seq y xs)) ()
$ S.zipWith (,) src src
{-# INLINE concat #-}
concat :: Stream Int -> ()
concat src = transform $ (S.concatMap (S.replicate 3) src)
-}
main :: P.IO ()
main = $(defaultMain "StreamlyArray")