on master help sign in
Add foldMany to unfolds
commit62fe488ac190a13b236a1e0301f889277657a63e authorHarendra Kumar <harendra@composewell.com> dateTue 22 Mar 2022, 23:55 (5 years ago) parent74e6a24
2 files changed+69−7
benchmark/Streamly/Benchmark/Data/Unfold.hs+16−3 core/src/Streamly/Internal/Data/Unfold.hs+53−4
benchmark/Streamly/Benchmark/Data/Unfold.hs+16−3
@@ -21,6 +21,8 @@ module Main (main) where
2121
2222import Control.DeepSeq (NFData(..))
2323import Control.Exception (SomeException, ErrorCall, try)
24+import Data.Char (ord)
25+import Data.Word (Word8)
2426import Streamly.Internal.Data.Unfold (Unfold)
2527import System.IO (Handle, hClose)
2628import System.Random (randomRIO)
@@ -693,8 +695,17 @@ o_1_space_zip size =
693695 ]
694696 ]
695697
696−o_1_space_nested :: Int -> [Benchmark]
697−o_1_space_nested size =
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+
707+o_1_space_nested :: BenchEnv -> Int -> [Benchmark]
708+o_1_space_nested env size =
698709 [ bgroup
699710 "nested"
700711 [ benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp size
@@ -711,6 +722,8 @@ o_1_space_nested size =
711722 , benchIO "filterSome" $ filterSome size
712723
713724 , benchIO "concat" $ concat size
725+ , mkBench "foldMany (Fold.takeEndBy_ (== lf) Fold.drain)" env
726+ $ \inh _ -> foldManySepBy inh
714727 ]
715728 ]
716729
@@ -819,7 +832,7 @@ main = do
819832 , o_1_space_transformation size
820833 , o_1_space_filtering size
821834 , o_1_space_zip size
822− , o_1_space_nested size
835+ , o_1_space_nested env size
823836 , o_1_space_copy_read_exceptions env
824837 ]
825838 , 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
362362 Skip s -> go SPEC fs s
363363 Stop -> extract fs
364364
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+
365373-- | Apply a fold multiple times on the output of an unfold.
366374--
367−-- /Unimplemented/
368−foldMany :: -- Monad m =>
369− Fold m b c -> Unfold m a b -> Unfold m a c
370−foldMany = undefined
375+-- /Pre-release/
376+{-# INLINE_NORMAL foldMany #-}
377+foldMany :: Monad m => Fold m b c -> Unfold m a b -> Unfold m a c
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
371420
372421-- | Apply a monadic function to each element of the stream and replace it
373422-- with the output of the resulting action.