mirror of
https://github.com/composewell/streamly.git
synced 2024-09-20 07:58:27 +03:00
push uncons/null/head/tail to StreamK
and implement direct versions of these as well.
This commit is contained in:
parent
9b78a64f80
commit
6530e7634f
@ -40,6 +40,11 @@ main = do
|
||||
, benchIO "fromFoldable" D.toNull D.sourceFromFoldable
|
||||
-- , benchIO "fromFoldableM" D.sourceFromFoldableM
|
||||
]
|
||||
, bgroup "elimination"
|
||||
[ benchIO "toNull" D.toNull D.sourceUnfoldrM
|
||||
, benchIO "uncons" D.uncons D.sourceUnfoldrM
|
||||
, benchIO "nullHeadTail" D.nullHeadTail D.sourceUnfoldrM
|
||||
]
|
||||
, bgroup "transformation"
|
||||
[ -- benchIO "scan" D.scan D.sourceUnfoldrM
|
||||
benchIO "map" D.map D.sourceUnfoldrM
|
||||
@ -66,7 +71,10 @@ main = do
|
||||
, benchIO "foldMapWithM" K.toNull K.sourceFoldMapWithM
|
||||
]
|
||||
, bgroup "elimination"
|
||||
[ benchFold "toList" K.toList K.sourceUnfoldrM
|
||||
[ benchIO "toNull" K.toNull K.sourceUnfoldrM
|
||||
, benchIO "uncons" K.uncons K.sourceUnfoldrM
|
||||
, benchIO "nullHeadTail" K.nullHeadTail K.sourceUnfoldrM
|
||||
, benchFold "toList" K.toList K.sourceUnfoldrM
|
||||
, benchFold "fold" K.foldl K.sourceUnfoldrM
|
||||
, benchFold "last" K.last K.sourceUnfoldrM
|
||||
]
|
||||
|
@ -55,6 +55,8 @@ main = do
|
||||
]
|
||||
, bgroup "elimination"
|
||||
[ benchIO "toNull" $ Ops.toNull serially
|
||||
, benchIO "uncons" Ops.uncons
|
||||
, benchIO "nullHeadTail" Ops.nullHeadTail
|
||||
, benchIO "mapM_" Ops.mapM_
|
||||
, benchIO "toList" Ops.toList
|
||||
, benchIO "foldr" Ops.foldr
|
||||
|
@ -11,7 +11,7 @@ module LinearOps where
|
||||
|
||||
import Prelude
|
||||
(Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=),
|
||||
subtract, undefined, Maybe(..), odd, Bool)
|
||||
subtract, undefined, Maybe(..), odd, Bool, not)
|
||||
|
||||
import qualified Streamly as S
|
||||
import qualified Streamly.Prelude as S
|
||||
@ -24,6 +24,8 @@ maxValue = value + 1000
|
||||
-- Benchmark ops
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
{-# INLINE uncons #-}
|
||||
{-# INLINE nullHeadTail #-}
|
||||
{-# INLINE scan #-}
|
||||
{-# INLINE mapM_ #-}
|
||||
{-# INLINE map #-}
|
||||
@ -44,7 +46,7 @@ maxValue = value + 1000
|
||||
{-# INLINE composeAllInFilters #-}
|
||||
{-# INLINE composeAllOutFilters #-}
|
||||
{-# INLINE composeMapAllInFilter #-}
|
||||
scan, mapM_, map, fmap, mapMaybe, filterEven, filterAllOut,
|
||||
uncons, nullHeadTail, scan, mapM_, map, fmap, mapMaybe, filterEven, filterAllOut,
|
||||
filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropAll,
|
||||
dropWhileTrue, dropWhileMTrue, zip,
|
||||
concat, composeAllInFilters, composeAllOutFilters,
|
||||
@ -163,6 +165,21 @@ runStream :: Monad m => Stream m a -> m ()
|
||||
runStream = S.runStream
|
||||
|
||||
toNull t = runStream . t
|
||||
uncons s = do
|
||||
r <- S.uncons s
|
||||
case r of
|
||||
Nothing -> return ()
|
||||
Just (_, t) -> uncons t
|
||||
nullHeadTail s = do
|
||||
r <- S.null s
|
||||
if not r
|
||||
then do
|
||||
_ <- S.head s
|
||||
t <- S.tail s
|
||||
case t of
|
||||
Nothing -> return ()
|
||||
Just x -> nullHeadTail x
|
||||
else return ()
|
||||
mapM_ = S.mapM_ (\_ -> return ())
|
||||
toList = S.toList
|
||||
foldr = S.foldr (:) []
|
||||
|
@ -14,7 +14,7 @@ module StreamDOps where
|
||||
-- subtract, undefined, Maybe(..))
|
||||
import Prelude
|
||||
(Monad, Int, (+), (.), return, (>), even, (<=),
|
||||
Maybe(..))
|
||||
Maybe(..), not)
|
||||
|
||||
import qualified Streamly.Streams.StreamD as S
|
||||
|
||||
@ -26,6 +26,8 @@ maxValue = value + 1000
|
||||
-- Benchmark ops
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
{-# INLINE uncons #-}
|
||||
{-# INLINE nullHeadTail #-}
|
||||
-- {-# INLINE scan #-}
|
||||
{-# INLINE map #-}
|
||||
{-# INLINE filterEven #-}
|
||||
@ -43,7 +45,7 @@ maxValue = value + 1000
|
||||
{-# INLINE composeAllOutFilters #-}
|
||||
{-# INLINE composeMapAllInFilter #-}
|
||||
-}
|
||||
map, filterEven, filterAllOut,
|
||||
uncons, nullHeadTail, map, filterEven, filterAllOut,
|
||||
filterAllIn, takeOne, takeAll -- takeWhileTrue, dropAll, dropWhileTrue, zip,
|
||||
-- concat, composeAllInFilters, composeAllOutFilters,
|
||||
-- composeMapAllInFilter
|
||||
@ -111,6 +113,21 @@ runStream :: Monad m => Stream m a -> m ()
|
||||
runStream = S.runStream
|
||||
|
||||
toNull = runStream
|
||||
uncons s = do
|
||||
r <- S.uncons s
|
||||
case r of
|
||||
Nothing -> return ()
|
||||
Just (_, t) -> uncons t
|
||||
nullHeadTail s = do
|
||||
r <- S.null s
|
||||
if not r
|
||||
then do
|
||||
_ <- S.head s
|
||||
t <- S.tail s
|
||||
case t of
|
||||
Nothing -> return ()
|
||||
Just x -> nullHeadTail x
|
||||
else return ()
|
||||
toList = S.toList
|
||||
foldl = S.foldl' (+) 0
|
||||
last = S.last
|
||||
|
@ -11,7 +11,7 @@ module StreamKOps where
|
||||
|
||||
import Prelude
|
||||
(Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=),
|
||||
subtract, undefined, Maybe(..))
|
||||
subtract, undefined, Maybe(..), not)
|
||||
|
||||
import qualified Streamly.Streams.StreamK as S hiding (runStream)
|
||||
-- import qualified Streamly.Streams.Serial as S
|
||||
@ -26,6 +26,9 @@ maxValue = value + 1000
|
||||
-- Benchmark ops
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
{-# INLINE toNull #-}
|
||||
{-# INLINE uncons #-}
|
||||
{-# INLINE nullHeadTail #-}
|
||||
{-# INLINE scan #-}
|
||||
{-# INLINE map #-}
|
||||
{-# INLINE filterEven #-}
|
||||
@ -41,7 +44,7 @@ maxValue = value + 1000
|
||||
{-# INLINE composeAllInFilters #-}
|
||||
{-# INLINE composeAllOutFilters #-}
|
||||
{-# INLINE composeMapAllInFilter #-}
|
||||
scan, map, filterEven, filterAllOut,
|
||||
toNull, uncons, nullHeadTail, scan, map, filterEven, filterAllOut,
|
||||
filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropWhileTrue, zip,
|
||||
concat, composeAllInFilters, composeAllOutFilters,
|
||||
composeMapAllInFilter
|
||||
@ -58,9 +61,7 @@ foldl :: Monad m => Stream m Int -> m Int
|
||||
{-# INLINE last #-}
|
||||
last :: Monad m => Stream m Int -> m (Maybe Int)
|
||||
|
||||
{-# INLINE toNull #-}
|
||||
{-# INLINE mapM #-}
|
||||
toNull :: Monad m => Stream m Int -> m ()
|
||||
mapM :: S.MonadAsync m => Stream m Int -> m ()
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
@ -122,6 +123,23 @@ runStream :: Monad m => Stream m a -> m ()
|
||||
runStream = S.runStream
|
||||
|
||||
toNull = runStream
|
||||
uncons s = do
|
||||
r <- S.uncons s
|
||||
case r of
|
||||
Nothing -> return ()
|
||||
Just (_, t) -> uncons t
|
||||
|
||||
nullHeadTail s = do
|
||||
r <- S.null s
|
||||
if not r
|
||||
then do
|
||||
_ <- S.head s
|
||||
t <- S.tail s
|
||||
case t of
|
||||
Nothing -> return ()
|
||||
Just x -> nullHeadTail x
|
||||
else return ()
|
||||
|
||||
toList = S.toList
|
||||
foldl = S.foldl' (+) 0
|
||||
last = S.last
|
||||
|
@ -210,11 +210,7 @@ toStreamD = D.fromStreamK . toStream
|
||||
--
|
||||
-- @since 0.1.0
|
||||
uncons :: (IsStream t, Monad m) => SerialT m a -> m (Maybe (a, t m a))
|
||||
uncons m =
|
||||
let stop = return Nothing
|
||||
single a = return (Just (a, K.nil))
|
||||
yieldk a r = return (Just (a, fromStream r))
|
||||
in (K.unStream (toStream m)) Nothing stop single yieldk
|
||||
uncons m = K.uncons (K.adapt m)
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Generation by Unfolding
|
||||
@ -500,32 +496,23 @@ foldlM' step begin m = S.foldlM' step begin $ toStreamS m
|
||||
-- | Determine whether the stream is empty.
|
||||
--
|
||||
-- @since 0.1.1
|
||||
{-# INLINE null #-}
|
||||
null :: Monad m => SerialT m a -> m Bool
|
||||
null m =
|
||||
let stop = return True
|
||||
single _ = return False
|
||||
yieldk _ _ = return False
|
||||
in (K.unStream (toStream m)) Nothing stop single yieldk
|
||||
null m = K.null m
|
||||
|
||||
-- | Extract the first element of the stream, if any.
|
||||
--
|
||||
-- @since 0.1.0
|
||||
{-# INLINE head #-}
|
||||
head :: Monad m => SerialT m a -> m (Maybe a)
|
||||
head m =
|
||||
let stop = return Nothing
|
||||
single a = return (Just a)
|
||||
yieldk a _ = return (Just a)
|
||||
in (K.unStream (toStream m)) Nothing stop single yieldk
|
||||
head m = K.head m
|
||||
|
||||
-- | Extract all but the first element of the stream, if any.
|
||||
--
|
||||
-- @since 0.1.1
|
||||
{-# INLINE tail #-}
|
||||
tail :: (IsStream t, Monad m) => SerialT m a -> m (Maybe (t m a))
|
||||
tail m =
|
||||
let stop = return Nothing
|
||||
single _ = return $ Just K.nil
|
||||
yieldk _ r = return $ Just $ fromStream r
|
||||
in (K.unStream (toStream m)) Nothing stop single yieldk
|
||||
tail m = K.tail (K.adapt m)
|
||||
|
||||
-- | Extract the last element of the stream, if any.
|
||||
--
|
||||
|
@ -30,7 +30,7 @@
|
||||
-- import qualified Streamly.Streams.StreamD as D
|
||||
-- @
|
||||
|
||||
-- A majority of functions in this file have been adapted from the vector
|
||||
-- Some of functions in this file have been adapted from the vector
|
||||
-- library, https://hackage.haskell.org/package/vector.
|
||||
|
||||
module Streamly.Streams.StreamD
|
||||
@ -74,6 +74,9 @@ module Streamly.Streams.StreamD
|
||||
|
||||
-- ** Specialized Folds
|
||||
, runStream
|
||||
, null
|
||||
, head
|
||||
, tail
|
||||
, last
|
||||
, elem
|
||||
, notElem
|
||||
@ -119,7 +122,7 @@ import GHC.Types ( SPEC(..) )
|
||||
import Prelude
|
||||
hiding (map, mapM, mapM_, repeat, foldr, last, take, filter,
|
||||
takeWhile, drop, dropWhile, all, any, maximum, minimum, elem,
|
||||
notElem)
|
||||
notElem, null, head, tail)
|
||||
|
||||
import Streamly.SVar (MonadAsync)
|
||||
import qualified Streamly.Streams.StreamK as K
|
||||
@ -151,7 +154,7 @@ data Stream m a = forall s. Stream (s -> m (Step s a)) s
|
||||
nil :: Monad m => Stream m a
|
||||
nil = Stream (const $ return Stop) ()
|
||||
|
||||
-- | Note that the cons operation is not scalable as it has O(n^2) complexity.
|
||||
-- | Can fuse but has O(n^2) complexity.
|
||||
cons :: Monad m => a -> Stream m a -> Stream m a
|
||||
cons x (Stream step state) = Stream step1 Nothing
|
||||
where
|
||||
@ -166,6 +169,7 @@ cons x (Stream step state) = Stream step1 Nothing
|
||||
-- Deconstruction
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
-- Does not fuse, has the same performance as the StreamK version.
|
||||
{-# INLINE_NORMAL uncons #-}
|
||||
uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))
|
||||
uncons (Stream step state) = go state
|
||||
@ -311,6 +315,39 @@ runStream (Stream step state) = go SPEC state
|
||||
Yield _ s -> go SPEC s
|
||||
Stop -> return ()
|
||||
|
||||
{-# INLINE_NORMAL null #-}
|
||||
null :: Monad m => Stream m a -> m Bool
|
||||
null (Stream step state) = go state
|
||||
where
|
||||
go st = do
|
||||
r <- step st
|
||||
case r of
|
||||
Yield _ _ -> return False
|
||||
Stop -> return True
|
||||
|
||||
-- XXX SPEC?
|
||||
{-# INLINE_NORMAL head #-}
|
||||
head :: Monad m => Stream m a -> m (Maybe a)
|
||||
head (Stream step state) = go state
|
||||
where
|
||||
go st = do
|
||||
r <- step st
|
||||
case r of
|
||||
Yield x _ -> return (Just x)
|
||||
Stop -> return Nothing
|
||||
|
||||
-- Does not fuse, has the same performance as the StreamK version.
|
||||
{-# INLINE_NORMAL tail #-}
|
||||
tail :: Monad m => Stream m a -> m (Maybe (Stream m a))
|
||||
tail (Stream step state) = go state
|
||||
where
|
||||
go st = do
|
||||
r <- step st
|
||||
case r of
|
||||
Yield _ s -> return (Just $ Stream step s)
|
||||
Stop -> return Nothing
|
||||
|
||||
-- XXX will it fuse? need custom impl?
|
||||
{-# INLINE_NORMAL last #-}
|
||||
last :: Monad m => Stream m a -> m (Maybe a)
|
||||
last = foldl' (\_ y -> Just y) Nothing
|
||||
|
@ -48,6 +48,9 @@ module Streamly.Streams.StreamK
|
||||
, yieldK
|
||||
, consK
|
||||
|
||||
-- * Deconstruction
|
||||
, uncons
|
||||
|
||||
-- * Generation
|
||||
-- ** Unfolds
|
||||
, unfoldr
|
||||
@ -75,6 +78,9 @@ module Streamly.Streams.StreamK
|
||||
|
||||
-- ** Specialized Folds
|
||||
, runStream
|
||||
, null
|
||||
, head
|
||||
, tail
|
||||
, elem
|
||||
, notElem
|
||||
, all
|
||||
@ -131,7 +137,7 @@ import Data.Semigroup (Semigroup(..))
|
||||
import Prelude
|
||||
hiding (foldl, foldr, last, map, mapM, mapM_, repeat, sequence,
|
||||
take, filter, all, any, takeWhile, drop, dropWhile, minimum,
|
||||
maximum, elem, notElem)
|
||||
maximum, elem, notElem, null, head, tail)
|
||||
import qualified Prelude
|
||||
|
||||
import Streamly.SVar
|
||||
@ -337,6 +343,18 @@ instance IsStream Stream where
|
||||
(|:) :: Monad m => m a -> Stream m a -> Stream m a
|
||||
(|:) = consMSerial
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Deconstruction
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
{-# INLINE uncons #-}
|
||||
uncons :: (IsStream t, Monad m) => t m a -> m (Maybe (a, t m a))
|
||||
uncons m =
|
||||
let stop = return Nothing
|
||||
single a = return (Just (a, nil))
|
||||
yieldk a r = return (Just (a, fromStream r))
|
||||
in (unStream (toStream m)) Nothing stop single yieldk
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Generation
|
||||
-------------------------------------------------------------------------------
|
||||
@ -514,6 +532,7 @@ foldlM' step begin m = foldxM step (return begin) return m
|
||||
-- Specialized folds
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
{-# INLINE runStream #-}
|
||||
runStream :: (Monad m, IsStream t) => t m a -> m ()
|
||||
runStream m = go (toStream m)
|
||||
where
|
||||
@ -521,7 +540,31 @@ runStream m = go (toStream m)
|
||||
let stop = return ()
|
||||
single _ = return ()
|
||||
yieldk _ r = go (toStream r)
|
||||
in (unStream m1) Nothing stop single yieldk
|
||||
in unStream m1 Nothing stop single yieldk
|
||||
|
||||
{-# INLINE null #-}
|
||||
null :: (IsStream t, Monad m) => t m a -> m Bool
|
||||
null m =
|
||||
let stop = return True
|
||||
single _ = return False
|
||||
yieldk _ _ = return False
|
||||
in unStream (toStream m) Nothing stop single yieldk
|
||||
|
||||
{-# INLINE head #-}
|
||||
head :: (IsStream t, Monad m) => t m a -> m (Maybe a)
|
||||
head m =
|
||||
let stop = return Nothing
|
||||
single a = return (Just a)
|
||||
yieldk a _ = return (Just a)
|
||||
in unStream (toStream m) Nothing stop single yieldk
|
||||
|
||||
{-# INLINE tail #-}
|
||||
tail :: (IsStream t, Monad m) => t m a -> m (Maybe (t m a))
|
||||
tail m =
|
||||
let stop = return Nothing
|
||||
single _ = return $ Just nil
|
||||
yieldk _ r = return $ Just $ fromStream r
|
||||
in unStream (toStream m) Nothing stop single yieldk
|
||||
|
||||
{-# INLINE elem #-}
|
||||
elem :: (IsStream t, Monad m, Eq a) => a -> t m a -> m Bool
|
||||
|
Loading…
Reference in New Issue
Block a user