a9aa3ae · streamly · git.iko.soy

git.iko.soy/streamly

Add Prelude#foldl1', Prelude#foldr1

commita9aa3aeef847abe3e43661b07000e93700794da2 authorVeladus <veladus@web.de> dateMon 23 Jul 2018, 21:58 (8 years ago) parent9706067

3 files changed+42−3

compare with master

unifiedsplit

src/Streamly/Prelude.hs+20−1 src/Streamly/Streams/StreamK.hs+17−1 test/Prop.hs+5−1

src/Streamly/Prelude.hs+20−1

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

8282 -- * Elimination

8383 -- ** General Folds

8484 , foldr

85+ , foldr1

8586 , foldrM

8687 , foldl'

88+ , foldl1'

8789 , foldlM'

8890 , foldx

8991 , foldxM

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

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

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

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

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

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

179181import qualified Prelude

180182import qualified System.IO as IO

181183

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

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

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

467469

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+

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

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

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

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

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

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

490498

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+

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

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

493512--

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

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

7171 , foldStream

7272 , foldr

7373 , foldrM

74+ , foldr1

7475 , foldl'

7576 , foldlM'

7677 , foldx

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

148149import Prelude

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

150151 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)

152154import qualified Prelude

153155

154156import Streamly.SVar

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

492494 yieldk a r = go r >>= step a

493495 in (unStream m1) defState stop single yieldk

494496

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+

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

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

497513-- 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)

1010import Control.Monad (replicateM, replicateM_)

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

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

13− elemIndex, find, intersperse)

13+ elemIndex, find, intersperse, foldl1')

1414import Data.Maybe (mapMaybe)

1515import GHC.Word (Word8)

1616

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

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

483483 prop (desc ++ " foldl") $

484484 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

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

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

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