8061c97 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Use monadic seed in monadic scanning combinators.

8061c97pranaysashank6 years ago

Changelog.md+2

compare with master

unifiedsplit

@@ -11,6 +11,8 @@

11* Deprecate `Streamly.Data.Unicode.Stream` in favor of `Streamly.Unicode.Stream`

12* Change the signature of `foldlM'` to make the initial value of the

13 accumulator monadic.

14+* Change the signature of `scanlM'`, `postscanlM'` to make the initial value of

15+ the accumulator monadic.

14* Change the signature of `concatMapWith` to ensure that it can be

16* Change the signature of `concatMapWith` to ensure that it can be

15 used with a wide variety of combining functions.

17 used with a wide variety of combining functions.

16* Exception handling functions `bracket`, `handle`, `finally` now

18* Exception handling functions `bracket`, `handle`, `finally` now

benchmark/Streamly/Benchmark/Prelude/Serial.hs+3−3

@@ -861,7 +861,7 @@ scan n = composeN n $ S.scanl' (+) 0

861

862{-# INLINE scanlM' #-}

863scanlM' :: MonadIO m => Int -> SerialT m Int -> m ()

864−scanlM' n = composeN n $ S.scanlM' (\b a -> return $ b + a) 0

864+scanlM' n = composeN n $ S.scanlM' (\b a -> return $ b + a) (return 0)

865

866{-# INLINE scanl1' #-}

867scanl1' :: MonadIO m => Int -> SerialT m Int -> m ()

@@ -873,7 +873,7 @@ postscanl' n = composeN n $ S.postscanl' (+) 0

873

874{-# INLINE postscanlM' #-}

875postscanlM' :: MonadIO m => Int -> SerialT m Int -> m ()

876−postscanlM' n = composeN n $ S.postscanlM' (\b a -> return $ b + a) 0

876+postscanlM' n = composeN n $ S.postscanlM' (\b a -> return $ b + a) (return 0)

877

878{-# INLINE sequence #-}

879sequence ::

@@ -983,7 +983,7 @@ sieveScan =

983 let ps = takeWhile (\p -> p * p <= n) primes

984 in if P.all (\p -> n `mod` p /= 0) ps

985 then (primes ++ [n], Just n)

986− else (primes, Nothing)) ([2], Just 2)

986+ else (primes, Nothing)) (return ([2], Just 2))

987

988o_n_space_mapping :: Int -> [Benchmark]

989o_n_space_mapping value =

src/Streamly/Internal/Data/Stream/IsStream.hs+12−8

@@ -2201,11 +2201,13 @@ scanx = P.scanlx'

2201-- complexity when iterated over a stream. We should use StreamK style scanlM'

2202-- for linear performance on iteration.

2203--

2204−-- | Like 'scanl'' but with a monadic fold function.

2204+-- | Like 'scanl'' but with a monadic step function and a monadic seed.

2205--

2206−-- @since 0.4.0

2206+-- /Since: 0.4.0/

2207+--

2208+-- /Since: 0.8.0 (signature change)/

2207{-# INLINE scanlM' #-}

2209{-# INLINE scanlM' #-}

2208−scanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> b -> t m a -> t m b

2210+scanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> t m b

2209scanlM' step begin m = fromStreamD $ D.scanlM' step begin $ toStreamD m

2211scanlM' step begin m = fromStreamD $ D.scanlM' step begin $ toStreamD m

2210

2212

2211-- | @scanlMAfter' accumulate initial done stream@ is like 'scanlM'' except

2213-- | @scanlMAfter' accumulate initial done stream@ is like 'scanlM'' except

@@ -2290,11 +2292,13 @@ postscanl' :: (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> t m b

2290postscanl' step z m = fromStreamD $ D.postscanl' step z $ toStreamD m

2292postscanl' step z m = fromStreamD $ D.postscanl' step z $ toStreamD m

2291

2293

2292-- XXX this needs to be concurrent

2294-- XXX this needs to be concurrent

2293−-- | Like 'postscanl'' but with a monadic step function.

2295+-- | Like 'postscanl'' but with a monadic step function and a monadic seed.

2294--

2296--

2295−-- @since 0.7.0

2297+-- /Since: 0.7.0/

2298+--

2299+-- /Since: 0.8.0 (signature change)/

2296{-# INLINE postscanlM' #-}

2300{-# INLINE postscanlM' #-}

2297−postscanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> b -> t m a -> t m b

2301+postscanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> t m b

2298postscanlM' step z m = fromStreamD $ D.postscanlM' step z $ toStreamD m

2302postscanlM' step z m = fromStreamD $ D.postscanlM' step z $ toStreamD m

2299

2303

2300-- XXX prescanl does not sound very useful, enable only if there is a

2304-- XXX prescanl does not sound very useful, enable only if there is a

@@ -2308,7 +2312,7 @@ prescanl' :: (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> t m b

2308prescanl' step z m = fromStreamD $ D.prescanl' step z $ toStreamD m

2312prescanl' step z m = fromStreamD $ D.prescanl' step z $ toStreamD m

2309

2313

2310-- XXX this needs to be concurrent

2314-- XXX this needs to be concurrent

2311−-- | Like postscanl' but with a monadic step function.

2315+-- | Like prescanl' but with a monadic step function and a monadic seed.

2312--

2316--

2313-- /Internal/

2317-- /Internal/

2314{-# INLINE prescanlM' #-}

2318{-# INLINE prescanlM' #-}

@@ -2605,7 +2609,7 @@ smapM step initial stream =

2605 -- stream

2609 -- stream

2606 let r = concatMap

2610 let r = concatMap

2607 (\s0 ->

2611 (\s0 ->

2608− postscanlM' (\(s, _) a -> step s a) (s0, undefined) stream

2612+ postscanlM' (\(s, _) a -> step s a) (return (s0, undefined)) stream

2609 )

2613 )

2610 (yieldM initial)

2614 (yieldM initial)

2611 in Serial.map snd r

2615 in Serial.map snd r

src/Streamly/Internal/Data/Stream/StreamD.hs+53−19

@@ -3616,23 +3616,27 @@ scanlx' fstep begin done s =

3616------------------------------------------------------------------------------

3617

3618{-# INLINE_NORMAL postscanlM' #-}

3619−postscanlM' :: Monad m => (b -> a -> m b) -> b -> Stream m a -> Stream m b

3619+postscanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b

3620postscanlM' fstep begin (Stream step state) =

3621− begin `seq` Stream step' (state, begin)

3621+ Stream step' Nothing

3622 where

3623 {-# INLINE_LATE step' #-}

3624+ step' _ Nothing = do

3625+ !x <- begin

3626+ return $ Skip (Just (state, x))

3627+

3624− step' gst (st, acc) = acc `seq` do

3628+ step' gst (Just (st, acc)) = do

3625 r <- step (adaptState gst) st

3629 r <- step (adaptState gst) st

3626 case r of

3630 case r of

3627 Yield x s -> do

3631 Yield x s -> do

3628− y <- fstep acc x

3632+ !y <- fstep acc x

3629− y `seq` return (Yield y (s, y))

3633+ return $ Yield y (Just (s, y))

3630− Skip s -> return $ Skip (s, acc)

3634+ Skip s -> return $ Skip (Just (s, acc))

3631 Stop -> return Stop

3635 Stop -> return Stop

3632

3636

3633{-# INLINE_NORMAL postscanl' #-}

3637{-# INLINE_NORMAL postscanl' #-}

3634postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a

3638postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a

3635−postscanl' f = postscanlM' (\a b -> return (f a b))

3639+postscanl' f seed = postscanlM' (\a b -> return (f a b)) (return seed)

3636

3640

3637-- We can possibly have the "done" function as a Maybe to provide an option to

3641-- We can possibly have the "done" function as a Maybe to provide an option to

3638-- emit or not emit the accumulator when the stream stops.

3642-- emit or not emit the accumulator when the stream stops.

@@ -3660,26 +3664,43 @@ postscanlMAfter' fstep initial done (Stream step1 state1) = do

3660 step _ Nothing = return Stop

3664 step _ Nothing = return Stop

3661

3665

3662{-# INLINE_NORMAL postscanlM #-}

3666{-# INLINE_NORMAL postscanlM #-}

3663−postscanlM :: Monad m => (b -> a -> m b) -> b -> Stream m a -> Stream m b

3667+postscanlM :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b

3664−postscanlM fstep begin (Stream step state) = Stream step' (state, begin)

3668+postscanlM fstep begin (Stream step state) = Stream step' Nothing

3665 where

3669 where

3666 {-# INLINE_LATE step' #-}

3670 {-# INLINE_LATE step' #-}

3671+ step' _ Nothing = do

3672+ r <- begin

3673+ return $ Skip (Just (state, r))

3674+

3667− step' gst (st, acc) = do

3675+ step' gst (Just (st, acc)) = do

3668 r <- step (adaptState gst) st

3676 r <- step (adaptState gst) st

3669 case r of

3677 case r of

3670 Yield x s -> do

3678 Yield x s -> do

3671 y <- fstep acc x

3679 y <- fstep acc x

3672− return (Yield y (s, y))

3680+ return (Yield y (Just (s, y)))

3673− Skip s -> return $ Skip (s, acc)

3681+ Skip s -> return $ Skip (Just (s, acc))

3674 Stop -> return Stop

3682 Stop -> return Stop

3675

3683

3676{-# INLINE_NORMAL postscanl #-}

3684{-# INLINE_NORMAL postscanl #-}

3677postscanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a

3685postscanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a

3678−postscanl f = postscanlM (\a b -> return (f a b))

3686+postscanl f seed = postscanlM (\a b -> return (f a b)) (return seed)

3679

3687

3680{-# INLINE_NORMAL scanlM' #-}

3688{-# INLINE_NORMAL scanlM' #-}

3681−scanlM' :: Monad m => (b -> a -> m b) -> b -> Stream m a -> Stream m b

3689+scanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b

3682−scanlM' fstep begin s = begin `seq` (begin `cons` postscanlM' fstep begin s)

3690+scanlM' fstep begin (Stream step state) = Stream step' Nothing

3691+ where

3692+ {-# INLINE_LATE step' #-}

3693+ step' _ Nothing = do

3694+ !x <- begin

3695+ return $ Yield x (Just (state, x))

3696+ step' gst (Just (st, acc)) = do

3697+ r <- step (adaptState gst) st

3698+ case r of

3699+ Yield x s -> do

3700+ !y <- fstep acc x

3701+ return $ Yield y (Just (s, y))

3702+ Skip s -> return $ Skip (Just (s, acc))

3703+ Stop -> return Stop

3683

3704

3684{-# INLINE scanlMAfter' #-}

3705{-# INLINE scanlMAfter' #-}

3685scanlMAfter' :: Monad m

3706scanlMAfter' :: Monad m

@@ -3690,15 +3711,28 @@ scanlMAfter' fstep initial done s =

3690

3711

3691{-# INLINE scanl' #-}

3712{-# INLINE scanl' #-}

3692scanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b

3713scanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b

3693−scanl' f = scanlM' (\a b -> return (f a b))

3714+scanl' f seed = scanlM' (\a b -> return (f a b)) (return seed)

3694

3715

3695{-# INLINE_NORMAL scanlM #-}

3716{-# INLINE_NORMAL scanlM #-}

3696−scanlM :: Monad m => (b -> a -> m b) -> b -> Stream m a -> Stream m b

3717+scanlM :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b

3697−scanlM fstep begin s = begin `cons` postscanlM fstep begin s

3718+scanlM fstep begin (Stream step state) = Stream step' Nothing

3719+ where

3720+ {-# INLINE_LATE step' #-}

3721+ step' _ Nothing = do

3722+ x <- begin

3723+ return $ Yield x (Just (state, x))

3724+ step' gst (Just (st, acc)) = do

3725+ r <- step (adaptState gst) st

3726+ case r of

3727+ Yield x s -> do

3728+ y <- fstep acc x

3729+ return $ Yield y (Just (s, y))

3730+ Skip s -> return $ Skip (Just (s, acc))

3731+ Stop -> return $ Stop

3698

3732

3699{-# INLINE scanl #-}

3733{-# INLINE scanl #-}

3700scanl :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b

3734scanl :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b

3701−scanl f = scanlM (\a b -> return (f a b))

3735+scanl f seed = scanlM (\a b -> return (f a b)) (return seed)

3702

3736

3703{-# INLINE_NORMAL scanl1M #-}

3737{-# INLINE_NORMAL scanl1M #-}

3704scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a

3738scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a

test/Streamly/Test/Prelude/Common.hs+10−10

@@ -642,8 +642,8 @@ bindAndComposeHierarchyOps ::

642bindAndComposeHierarchyOps desc t1 = do

643 let fldldesc = "Bind and compose foldl, " <> desc <> " Stream "

644 fldrdesc = "Bind and compose foldr, " <> desc <> " Stream "

645−

645+

646− bindAndComposeHierarchy

646+ bindAndComposeHierarchy

647 (fldldesc <> "serially") S.serially fldl

648 bindAndComposeHierarchy

649 (fldrdesc <> "serially") S.serially fldr

@@ -707,21 +707,21 @@ bindAndComposeHierarchyOps desc t1 = do

707 mx >>= \x -> my

708 >>= \y -> mz

709 >>= \z -> return (x + y + z)

710−

710+

711− fldr, fldl :: (IsStream t, Semigroup (t IO Int))

711+ fldr, fldl :: (IsStream t, Semigroup (t IO Int))

712 => [t IO Int] -> t IO Int

713 fldr = foldr (<>) nil

714 fldl = foldl (<>) nil

715

716-- Nest two lists using different styles of product compositions

717−nestTwoStreams

717+nestTwoStreams

718 :: (IsStream t, Semigroup (t IO Int), Monad (t IO))

719 => String

720 -> ([Int] -> [Int])

721 -> ([Int] -> [Int])

722 -> (t IO Int -> SerialT IO Int)

723 -> Spec

724−nestTwoStreams desc streamListT listT t =

724+nestTwoStreams desc streamListT listT t =

725 it ("Nests two streams using monadic " <> desc <> " composition") $ do

726 let s1 = S.concatMapFoldableWith (<>) return [1..4]

727 s2 = S.concatMapFoldableWith (<>) return [5..8]

@@ -731,19 +731,19 @@ nestTwoStreams desc streamListT listT t =

731 return $ x + y

732 streamListT r `shouldBe` listT [6,7,8,9,7,8,9,10,8,9,10,11,9,10,11,12]

733

734−nestTwoStreamsApp

734+nestTwoStreamsApp

735 :: (IsStream t, Semigroup (t IO Int), Monad (t IO))

736 => String

737 -> ([Int] -> [Int])

738 -> ([Int] -> [Int])

739 -> (t IO Int -> SerialT IO Int)

740 -> Spec

741−nestTwoStreamsApp desc streamListT listT t =

741+nestTwoStreamsApp desc streamListT listT t =

742 it ("Nests two streams using applicative " <> desc <> " composition") $ do

743 let s1 = S.concatMapFoldableWith (<>) return [1..4]

744 s2 = S.concatMapFoldableWith (<>) return [5..8]

745 r = (S.toList . t) $ ((+) <$> s1 <*> s2)

746− streamListT <$> r

746+ streamListT <$> r

747 `shouldReturn` listT [6,7,8,9,7,8,9,10,8,9,10,11,9,10,11,12]

748

749

@@ -926,7 +926,7 @@ transformCombineOpsCommon constr desc eq t = do

926 prop (desc <> " scanl'") $ transform (scanl' (flip const) 0) t

927 (S.scanl' (flip const) 0)

928 prop (desc <> " scanlM'") $ transform (scanl' (flip const) 0) t

929− (S.scanlM' (\_ a -> return a) 0)

929+ (S.scanlM' (\_ a -> return a) (return 0))

930 prop (desc <> " scanl") $ transform (scanl' (flip const) 0) t

931 (S.scanl' (flip const) 0)

932 prop (desc <> " scanl1'") $ transform (scanl1 (flip const)) t

test/Streamly/Test/Prelude/Fold.hs+1−1

@@ -114,7 +114,7 @@ foldlM'StrictCheck :: IORef Int -> SerialT IO Int -> IO ()

114foldlM'StrictCheck ref = S.foldlM' (\_ _ -> writeIORef ref 1) (return ())

115

116scanlM'StrictCheck :: IORef Int -> SerialT IO Int -> SerialT IO ()

117−scanlM'StrictCheck ref = S.scanlM' (\_ _ -> writeIORef ref 1) ()

117+scanlM'StrictCheck ref = S.scanlM' (\_ _ -> writeIORef ref 1) (return ())

118

119checkScanlMStrictness :: (IORef Int -> SerialT IO Int -> SerialT IO ()) -> IO ()

120checkScanlMStrictness f = do