a9aa3ae · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add Prelude#foldl1', Prelude#foldr1

a9aa3aeVeladus8 years ago

src/Streamly/Prelude.hs+20−1

compare with master

unifiedsplit

@@ -82,8 +82,10 @@ module Streamly.Prelude

82 -- * Elimination

83 -- ** General Folds

84 , foldr

85+ , foldr1

85 , foldrM

86 , foldrM

86 , foldl'

87 , foldl'

88+ , foldl1'

87 , foldlM'

89 , foldlM'

88 , foldx

90 , foldx

89 , foldxM

91 , foldxM

@@ -175,7 +177,7 @@ import Prelude

175 hiding (filter, drop, dropWhile, take, takeWhile, zipWith, foldr,

177 hiding (filter, drop, dropWhile, take, takeWhile, zipWith, foldr,

176 foldl, map, mapM, mapM_, sequence, all, any, sum, product, elem,

178 foldl, map, mapM, mapM_, sequence, all, any, sum, product, elem,

177 notElem, maximum, minimum, head, last, tail, length, null,

179 notElem, maximum, minimum, head, last, tail, length, null,

178− reverse, iterate, init, and, or, lookup)

180+ reverse, iterate, init, and, or, lookup, foldr1)

179import qualified Prelude

181import qualified Prelude

180import qualified System.IO as IO

182import qualified System.IO as IO

181

183

@@ -465,6 +467,12 @@ foldr :: Monad m => (a -> b -> b) -> b -> SerialT m a -> m b

465-- foldr step acc m = S.foldr step acc $ S.fromStreamK (toStream m)

467-- foldr step acc m = S.foldr step acc $ S.fromStreamK (toStream m)

466foldr f = foldrM (\a b -> return (f a b))

468foldr f = foldrM (\a b -> return (f a b))

467

469

470+-- | Right fold, for non-empty streams, using first element as the starting

471+-- value. Returns 'Nothing' if the stream is empty.

472+{-# INLINE foldr1 #-}

473+foldr1 :: Monad m => (a -> a -> a) -> SerialT m a -> m (Maybe a)

474+foldr1 = K.foldr1

475+

468-- | Strict left fold with an extraction function. Like the standard strict

476-- | Strict left fold with an extraction function. Like the standard strict

469-- left fold, but applies a user supplied extraction function (the third

477-- left fold, but applies a user supplied extraction function (the third

470-- argument) to the folded value at the end. This is designed to work with the

478-- argument) to the folded value at the end. This is designed to work with the

@@ -488,6 +496,17 @@ foldl = foldx

488foldl' :: Monad m => (b -> a -> b) -> b -> SerialT m a -> m b

496foldl' :: Monad m => (b -> a -> b) -> b -> SerialT m a -> m b

489foldl' step begin m = S.foldl' step begin $ toStreamS m

497foldl' step begin m = S.foldl' step begin $ toStreamS m

490

498

499+-- | Strict left fold, for non-empty streams, using first element as the

500+-- starting value. Returns 'Nothing' if the stream is empty.

501+foldl1' :: Monad m => (a -> a -> a) -> (a -> b) -> SerialT m a -> m (Maybe b)

502+foldl1' step done m = do

503+ r <- uncons m

504+ case r of

505+ Nothing -> return Nothing

506+ Just (h, t) -> do

507+ res <- foldl' step h t

508+ return $ Just $ done res

509+

491-- XXX replace the recursive "go" with explicit continuations.

510-- XXX replace the recursive "go" with explicit continuations.

492-- | Like 'foldx', but with a monadic step function.

511-- | Like 'foldx', but with a monadic step function.

493--

512--

src/Streamly/Streams/StreamK.hs+17−1

@@ -71,6 +71,7 @@ module Streamly.Streams.StreamK

71 , foldStream

72 , foldr

73 , foldrM

74+ , foldr1

74 , foldl'

75 , foldl'

75 , foldlM'

76 , foldlM'

76 , foldx

77 , foldx

@@ -148,7 +149,8 @@ import Data.Semigroup (Semigroup(..))

148import Prelude

149import Prelude

149 hiding (foldl, foldr, last, map, mapM, mapM_, repeat, sequence,

150 hiding (foldl, foldr, last, map, mapM, mapM_, repeat, sequence,

150 take, filter, all, any, takeWhile, drop, dropWhile, minimum,

151 take, filter, all, any, takeWhile, drop, dropWhile, minimum,

151− maximum, elem, notElem, null, head, tail, init, zipWith, lookup)

152+ maximum, elem, notElem, null, head, tail, init, zipWith, lookup,

153+ foldr1)

152import qualified Prelude

154import qualified Prelude

153

155

154import Streamly.SVar

156import Streamly.SVar

@@ -492,6 +494,20 @@ foldrM step acc m = go (toStream m)

492 yieldk a r = go r >>= step a

494 yieldk a r = go r >>= step a

493 in (unStream m1) defState stop single yieldk

495 in (unStream m1) defState stop single yieldk

494

496

497+{-# INLINE foldr1 #-}

498+foldr1 :: (IsStream t, Monad m) => (a -> a -> a) -> t m a -> m (Maybe a)

499+foldr1 step m = do

500+ r <- uncons m

501+ case r of

502+ Nothing -> return Nothing

503+ Just (h, t) -> go h (toStream t) >>= return . Just

504+ where

505+ go p m1 =

506+ let stp = return p

507+ single a = return $ step a p

508+ yieldk a r = go a r >>= return . (step p)

509+ in unStream m1 defState stp single yieldk

510+

495-- | Strict left fold with an extraction function. Like the standard strict

511-- | Strict left fold with an extraction function. Like the standard strict

496-- left fold, but applies a user supplied extraction function (the third

512-- left fold, but applies a user supplied extraction function (the third

497-- argument) to the folded value at the end. This is designed to work with the

513-- argument) to the folded value at the end. This is designed to work with the

test/Prop.hs+5−1

@@ -10,7 +10,7 @@ import Control.Concurrent (MVar, takeMVar, putMVar, newEmptyMVar)

10import Control.Monad (replicateM, replicateM_)

11import Data.IORef (readIORef, modifyIORef, newIORef)

12import Data.List (sort, foldl', scanl', findIndices, findIndex, elemIndices,

13− elemIndex, find, intersperse)

13+ elemIndex, find, intersperse, foldl1')

14import Data.Maybe (mapMaybe)

15import GHC.Word (Word8)

@@ -482,6 +482,10 @@ eliminationOps constr desc t = do

482 prop (desc ++ " null") $ eliminateOp constr null $ S.null . t

483 prop (desc ++ " foldl") $

484 eliminateOp constr (foldl' (+) 0) $ (S.foldl' (+) 0) . t

485+ prop (desc ++ " foldl1") $

486+ eliminateOp constr (wrapMaybe $ foldl1' (+)) $ (S.foldl1' (+) id) . t

487+ prop (desc ++ " foldr1") $

488+ eliminateOp constr (wrapMaybe $ foldr1 (+)) $ (S.foldr1 (+)) . t

485 prop (desc ++ " all") $ eliminateOp constr (all even) $ (S.all even) . t

489 prop (desc ++ " all") $ eliminateOp constr (all even) $ (S.all even) . t

486 prop (desc ++ " any") $ eliminateOp constr (any even) $ (S.any even) . t

490 prop (desc ++ " any") $ eliminateOp constr (any even) $ (S.any even) . t

487 prop (desc ++ " length") $ eliminateOp constr length $ S.length . t

491 prop (desc ++ " length") $ eliminateOp constr length $ S.length . t