diff --git a/benchmark/BaseStreams.hs b/benchmark/BaseStreams.hs index 0357933d9..0544f58fc 100644 --- a/benchmark/BaseStreams.hs +++ b/benchmark/BaseStreams.hs @@ -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 ] diff --git a/benchmark/Linear.hs b/benchmark/Linear.hs index 8cc23c9a7..2106600f6 100644 --- a/benchmark/Linear.hs +++ b/benchmark/Linear.hs @@ -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 diff --git a/benchmark/LinearOps.hs b/benchmark/LinearOps.hs index a9f45a36f..bb64829dc 100644 --- a/benchmark/LinearOps.hs +++ b/benchmark/LinearOps.hs @@ -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 (:) [] diff --git a/benchmark/StreamDOps.hs b/benchmark/StreamDOps.hs index 8958f24b2..421790b18 100644 --- a/benchmark/StreamDOps.hs +++ b/benchmark/StreamDOps.hs @@ -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 diff --git a/benchmark/StreamKOps.hs b/benchmark/StreamKOps.hs index 1c7b15061..d9899e2e4 100644 --- a/benchmark/StreamKOps.hs +++ b/benchmark/StreamKOps.hs @@ -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 diff --git a/src/Streamly/Prelude.hs b/src/Streamly/Prelude.hs index a24fcf15a..024d1a628 100644 --- a/src/Streamly/Prelude.hs +++ b/src/Streamly/Prelude.hs @@ -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. -- diff --git a/src/Streamly/Streams/StreamD.hs b/src/Streamly/Streams/StreamD.hs index 487d07a80..bb81dfce2 100644 --- a/src/Streamly/Streams/StreamD.hs +++ b/src/Streamly/Streams/StreamD.hs @@ -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 diff --git a/src/Streamly/Streams/StreamK.hs b/src/Streamly/Streams/StreamK.hs index 8ca1ba33d..fa13e6ffd 100644 --- a/src/Streamly/Streams/StreamK.hs +++ b/src/Streamly/Streams/StreamK.hs @@ -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