push uncons/null/head/tail to StreamK

and implement direct versions of these as well.

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
         ]

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

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 (:) []

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

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

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 =
+uncons m = K.uncons (K.adapt 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
 
 ------------------------------------------------------------------------------
 -- 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 =
+null m = K.null m
-    let stop      = return True
-        single _  = return False
-        yieldk _ _ = return False
-    in (K.unStream (toStream m)) Nothing stop single yieldk
 
 -- | 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 =
+head m = K.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
 
 -- | 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 =
+tail m = K.tail (K.adapt 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
 
 -- | Extract the last element of the stream, if any.
 --

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

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