git.iko.soy/streamly
on master help sign in
Add foldMany to unfolds
62fe488Harendra Kumar
benchmark/Streamly/Benchmark/Data/Unfold.hs+16−3
compare with master
unifiedsplit
@@ -21,6 +21,8 @@ module Main (main) where
21
21
22import Control.DeepSeq (NFData(..))
22import Control.DeepSeq (NFData(..))
23import Control.Exception (SomeException, ErrorCall, try)
23import Control.Exception (SomeException, ErrorCall, try)
24+import Data.Char (ord)
25+import Data.Word (Word8)
24import Streamly.Internal.Data.Unfold (Unfold)
26import Streamly.Internal.Data.Unfold (Unfold)
25import System.IO (Handle, hClose)
27import System.IO (Handle, hClose)
26import System.Random (randomRIO)
28import System.Random (randomRIO)
@@ -693,8 +695,17 @@ o_1_space_zip size =
693 ]
695 ]
694 ]
696 ]
695
697
698+lf :: Word8
699+lf = fromIntegral (ord '\n')
700+
701+-- | Split on line feed.
702+foldManySepBy :: Handle -> IO Int
703+foldManySepBy =
704+ let u = UF.foldMany (FL.takeEndBy_ (== lf) FL.drain) FH.read
705+ in UF.fold FL.length u
706+
696−o_1_space_nested :: Int -> [Benchmark]
707+o_1_space_nested :: BenchEnv -> Int -> [Benchmark]
697−o_1_space_nested size =
708+o_1_space_nested env size =
698 [ bgroup
709 [ bgroup
699 "nested"
710 "nested"
700 [ benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp size
711 [ benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp size
@@ -711,6 +722,8 @@ o_1_space_nested size =
711 , benchIO "filterSome" $ filterSome size
722 , benchIO "filterSome" $ filterSome size
712
723
713 , benchIO "concat" $ concat size
724 , benchIO "concat" $ concat size
725+ , mkBench "foldMany (Fold.takeEndBy_ (== lf) Fold.drain)" env
726+ $ \inh _ -> foldManySepBy inh
714 ]
727 ]
715 ]
728 ]
716
729
@@ -819,7 +832,7 @@ main = do
819 , o_1_space_transformation size
832 , o_1_space_transformation size
820 , o_1_space_filtering size
833 , o_1_space_filtering size
821 , o_1_space_zip size
834 , o_1_space_zip size
822− , o_1_space_nested size
835+ , o_1_space_nested env size
823 , o_1_space_copy_read_exceptions env
836 , o_1_space_copy_read_exceptions env
824 ]
837 ]
825 , bgroup (o_n_space_prefix moduleName)
838 , bgroup (o_n_space_prefix moduleName)
core/src/Streamly/Internal/Data/Unfold.hs+53−4
@@ -362,12 +362,61 @@ fold (Fold fstep initial extract) (Unfold ustep inject) a = do
362 Skip s -> go SPEC fs s
362 Skip s -> go SPEC fs s
363 Stop -> extract fs
363 Stop -> extract fs
364
364
365+-- {-# ANN type FoldMany Fuse #-}
366+data FoldMany s fs b a
367+ = FoldManyStart s
368+ | FoldManyFirst fs s
369+ | FoldManyLoop s fs
370+ | FoldManyYield b (FoldMany s fs b a)
371+ | FoldManyDone
372+
365-- | Apply a fold multiple times on the output of an unfold.
373-- | Apply a fold multiple times on the output of an unfold.
366--
374--
367−-- /Unimplemented/
375+-- /Pre-release/
368−foldMany :: -- Monad m =>
376+{-# INLINE_NORMAL foldMany #-}
369− Fold m b c -> Unfold m a b -> Unfold m a c
377+foldMany :: Monad m => Fold m b c -> Unfold m a b -> Unfold m a c
370−foldMany = undefined
378+foldMany (Fold fstep initial extract) (Unfold ustep inject1) =
379+ Unfold step inject
380+
381+ where
382+
383+ inject x = do
384+ r <- inject1 x
385+ return (FoldManyStart r)
386+
387+ {-# INLINE consume #-}
388+ consume x s fs = do
389+ res <- fstep fs x
390+ return
391+ $ Skip
392+ $ case res of
393+ FL.Done b -> FoldManyYield b (FoldManyStart s)
394+ FL.Partial ps -> FoldManyLoop s ps
395+
396+ {-# INLINE_LATE step #-}
397+ step (FoldManyStart st) = do
398+ r <- initial
399+ return
400+ $ Skip
401+ $ case r of
402+ FL.Done b -> FoldManyYield b (FoldManyStart st)
403+ FL.Partial fs -> FoldManyFirst fs st
404+ step (FoldManyFirst fs st) = do
405+ r <- ustep st
406+ case r of
407+ Yield x s -> consume x s fs
408+ Skip s -> return $ Skip (FoldManyFirst fs s)
409+ Stop -> return Stop
410+ step (FoldManyLoop st fs) = do
411+ r <- ustep st
412+ case r of
413+ Yield x s -> consume x s fs
414+ Skip s -> return $ Skip (FoldManyLoop s fs)
415+ Stop -> do
416+ b <- extract fs
417+ return $ Skip (FoldManyYield b FoldManyDone)
418+ step (FoldManyYield b next) = return $ Yield b next
419+ step FoldManyDone = return Stop
371
420
372-- | Apply a monadic function to each element of the stream and replace it
421-- | Apply a monadic function to each element of the stream and replace it
373-- with the output of the resulting action.
422-- with the output of the resulting action.