foldl 1.4.9 → 1.4.10

raw patch · 6 files changed

+192/−83 lines, 6 filesdep ~basedep ~bytestringPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, bytestring

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• bench/Foldl.hs +74/−0
• bench/Scanl.hs +86/−0
• bench/benchmarks.hs +0/−74
• foldl.cabal +16/−5
• src/Control/Scanl.hs +12/−4

@@ -1,3 +1,7 @@+1.4.10++* Fix space leaks in `scan` / `scanM`+ 1.4.9  * Implement `vector` utility more efficiently

@@ -0,0 +1,74 @@+{-# LANGUAGE BangPatterns #-}++module Main (main) where++import Control.Foldl hiding (map)+import Criterion.Main+import qualified Data.List+import Prelude hiding (length, sum)+import qualified Prelude+import qualified Data.Foldable as Foldable++main :: IO ()+main = defaultMain+  [ env (return [1..10000 :: Int]) $ \ns ->+      bgroup "[1..10000 :: Int]"+        [ bgroup "sum" $ map ($ ns)+            [ bench "fold sum" .+                whnf (fold sum)+            , bench "foldM (generalize sum)" .+                whnfIO . foldM (generalize sum)+            , bench "Prelude.sum" .+                whnf Prelude.sum+            , bench "Data.List.foldl' (+) 0" .+                whnf (Data.List.foldl' (+) 0)+            ]+        , bgroup "filtered" $ map ($ ns)+            [ bench "fold (handles (filtered even) list)" .+                nf (fold (handles (filtered even) list))+            , bench "foldM (handlesM (filtered even) (generalize list))" .+                nfIO . foldM (handlesM (filtered even) (generalize list))+            , bench "filter even" .+                nf (filter even)+            ]+        , bgroup "length" $ map ($ ns)+            [ bench "fold length" .+                whnf (fold length)+            , bench "foldM (generalize length)" .+                whnfIO . foldM (generalize length)+            , bench "Prelude.length" .+                whnf Prelude.length+            ]+        , bgroup "sumAndLength" $ map ($ ns)+            [ bench "naive sumAndLength" .+                nf sumAndLength+            , bench "foldl' sumAndLength" .+                nf sumAndLength'+            , bench "strict pair sumAndLength" .+                nf sumAndLength_Pair+            , bench "foldl sumAndLength" .+                nf sumAndLength_foldl+            ]+        ]+  ]+++sumAndLength :: Num a => [a] -> (a, Int)+sumAndLength xs = (Prelude.sum xs, Prelude.length xs)++sumAndLength' :: Num a => [a] -> (a, Int)+sumAndLength' xs = Foldable.foldl' step (0, 0) xs+  where+    step (x, y) n = (x + n, y + 1)++data Pair a b = Pair !a !b++sumAndLength_Pair :: Num a => [a] -> (a, Int)+sumAndLength_Pair xs = done (Foldable.foldl' step (Pair 0 0) xs)+  where+    step (Pair x y) n = Pair (x + n) (y + 1)++    done (Pair x y) = (x, y)++sumAndLength_foldl :: Num a => [a] -> (a, Int)+sumAndLength_foldl = fold ((,) <$> sum <*> length)

@@ -0,0 +1,86 @@+-- Copyright (c) 2020 Google LLC++-- | Benchmarks for the 'Control.Scanl' module.+--+-- These benchmarks can also be used to detect space leaks via the "limited+-- stack size" method. For example, to check all of the pure left scan+-- benchmarks via 'stack':+--+-- % stack bench :Scanl \+--   --benchmark-arguments='"[1..10000 :: Int]/sum of scan/" +RTS -K1K'+module Main (main) where++import Control.Category ((.))+import qualified Control.Foldl as Foldl+import Control.Scanl+import Criterion.Main+import Data.Foldable (foldl')+import Data.Functor.Identity (Identity(..))+import Prelude hiding ((.), scanr, sum)++-- A sum function guaranteed not to leak space on strict data types.+sum :: (Foldable t, Num a) => t a -> a+sum = foldl' (+) 0++scanSum :: Scan Int Int+scanSum = postscan Foldl.sum++scanMSum :: Monad m => ScanM m Int Int+scanMSum = generalize scanSum++scanProduct :: Scan Int Int+scanProduct = postscan Foldl.product++scanMProduct :: Monad m => ScanM m Int Int+scanMProduct = generalize scanProduct++main :: IO ()+main = defaultMain+  [ env (return [1..10000 :: Int]) $ \ns ->+      bgroup "[1..10000 :: Int]"+        [ bgroup "sum of scan" $ map ($ ns)+            [ bench "1" .+                whnf (sum . scan (1 :: Scan Int Int))+            , bench "scanSum" .+                whnf (sum . scan scanSum)+            , bench "scanProduct" .+                whnf (sum . scan scanProduct)+            , bench "fmap (+1) scanSum" .+                whnf (sum . scan (fmap (+1) scanSum))+            , bench "scanProduct / scanSum" .+                whnf (sum . scan (scanProduct + scanSum))+            , bench "scanProduct . scanSum" .+                whnf (sum . scan (scanProduct . scanSum))+            ]+        , bgroup "sum of scanM @Identity" $ map ($ ns)+            [ bench "1" .+                whnf (runIdentity . fmap sum . scanM (1 :: ScanM Identity Int Int))+            , bench "scanMSum" .+                whnf (runIdentity . fmap sum . scanM scanMSum)+            , bench "scanMProduct" .+                whnf (runIdentity . fmap sum . scanM scanMProduct)+            , bench "fmap (+1) scanMSum" .+                whnf (runIdentity . fmap sum . scanM (fmap (+1) scanMSum))+            , bench "scanMProduct / scanMSum" .+                whnf (runIdentity . fmap sum . scanM (scanMProduct + scanMSum))+            , bench "scanMProduct . scanMSum)" .+                whnf (runIdentity . fmap sum . scanM (scanMProduct . scanMSum))+            ]+        -- These right scans cannot be processed in constant space, so the+        -- "limited stack size" space leak test will always fail.+        , bgroup "sum of scanr" $ map ($ ns)+            [ bench "1" .+                whnf (sum . scanr (1 :: Scan Int Int))+            , bench "scanSum" .+                whnf (sum . scanr scanSum)+            , bench "scanProduct" .+                whnf (sum . scanr scanProduct)+            , bench "fmap (+1) scanSum" .+                whnf (sum . scanr (fmap (+1) scanSum))+            , bench "scanProduct / scanSum" .+                whnf (sum . scanr (scanProduct + scanSum))+            , bench "scanProduct . scanSum" .+                whnf (sum . scanr (scanProduct . scanSum))+            ]+        ]+  ]

@@ -1,74 +0,0 @@-{-# LANGUAGE BangPatterns #-}--module Main (main) where--import Control.Foldl hiding (map)-import Criterion.Main-import qualified Data.List-import Prelude hiding (length, sum)-import qualified Prelude-import qualified Data.Foldable as Foldable--main :: IO ()-main = defaultMain-  [ env (return [1..10000 :: Int]) $ \ns ->-      bgroup "[1..10000 :: Int]"-        [ bgroup "sum" $ map ($ ns)-            [ bench "fold sum" .-                whnf (fold sum)-            , bench "foldM (generalize sum)" .-                whnfIO . foldM (generalize sum)-            , bench "Prelude.sum" .-                whnf Prelude.sum-            , bench "Data.List.foldl' (+) 0" .-                whnf (Data.List.foldl' (+) 0)-            ]-        , bgroup "filtered" $ map ($ ns)-            [ bench "fold (handles (filtered even) list)" .-                nf (fold (handles (filtered even) list))-            , bench "foldM (handlesM (filtered even) (generalize list))" .-                nfIO . foldM (handlesM (filtered even) (generalize list))-            , bench "filter even" .-                nf (filter even)-            ]-        , bgroup "length" $ map ($ ns)-            [ bench "fold length" .-                whnf (fold length)-            , bench "foldM (generalize length)" .-                whnfIO . foldM (generalize length)-            , bench "Prelude.length" .-                whnf Prelude.length-            ]-        , bgroup "sumAndLength" $ map ($ ns)-            [ bench "naive sumAndLength" .-                nf sumAndLength-            , bench "foldl' sumAndLength" .-                nf sumAndLength'-            , bench "strict pair sumAndLength" .-                nf sumAndLength_Pair-            , bench "foldl sumAndLength" .-                nf sumAndLength_foldl-            ]-        ]-  ]---sumAndLength :: Num a => [a] -> (a, Int)-sumAndLength xs = (Prelude.sum xs, Prelude.length xs)--sumAndLength' :: Num a => [a] -> (a, Int)-sumAndLength' xs = Foldable.foldl' step (0, 0) xs-  where-    step (x, y) n = (x + n, y + 1)--data Pair a b = Pair !a !b--sumAndLength_Pair :: Num a => [a] -> (a, Int)-sumAndLength_Pair xs = done (Foldable.foldl' step (Pair 0 0) xs)-  where-    step (Pair x y) n = Pair (x + n) (y + 1)--    done (Pair x y) = (x, y)--sumAndLength_foldl :: Num a => [a] -> (a, Int)-sumAndLength_foldl = fold ((,) <$> sum <*> length)

@@ -1,5 +1,5 @@ Name: foldl-Version: 1.4.9+Version: 1.4.10 Cabal-Version: >=1.10 Build-Type: Simple License: BSD3@@ -35,7 +35,7 @@         unordered-containers        < 0.3 ,         hashable                    < 1.4 ,         contravariant               < 1.6 ,-        profunctors                 < 5.6 ,+        profunctors                 < 5.7 ,         semigroupoids >= 1.0     && < 5.4 ,         comonad      >= 4.0      && < 6     if impl(ghc < 8.0)@@ -54,15 +54,26 @@     GHC-Options: -O2 -Wall     Default-Language: Haskell2010 -Benchmark benchmarks+Benchmark Foldl     Type: exitcode-stdio-1.0     HS-Source-Dirs: bench-    Main-Is: benchmarks.hs+    Main-Is: Foldl.hs     Build-Depends:         base,         criterion,         foldl-    GHC-Options: -O2 -Wall -rtsopts -rtsopts -with-rtsopts=-T+    GHC-Options: -O2 -Wall -rtsopts -with-rtsopts=-T+    Default-Language: Haskell2010++Benchmark Scanl+    Type: exitcode-stdio-1.0+    HS-Source-Dirs: bench+    Main-Is: Scanl.hs+    Build-Depends:+        base,+        criterion,+        foldl+    GHC-Options: -O2 -Wall -rtsopts -with-rtsopts=-T     Default-Language: Haskell2010  Test-Suite doctest

@@ -5,7 +5,7 @@  >>> import qualified Control.Scanl as SL -    Use 'scan' to apply a 'Fold' to a list (or other 'Traversable' structures)+    Use 'scan' to apply a 'Scan' to a list (or other 'Traversable' structures)     from left to right, and 'scanr' to do so from right to left.      Note that the `Scan` type does not supersede the `Fold` type nor does the@@ -25,7 +25,7 @@      In other words, `Fold` is an instance of the `Comonad` typeclass. -    A `Scan`s cannot produce any output until provided with at least one+    A `Scan` cannot produce any output until provided with at least one     input. -} @@ -69,6 +69,7 @@ import Control.Foldl.Internal (Pair(..)) import Control.Monad ((<=<)) import Control.Monad.Trans.Class+import qualified Control.Monad.Trans.State.Lazy as Lazy import Control.Monad.Trans.State.Strict import Data.Functor.Identity import Data.Monoid hiding ((<>))@@ -82,6 +83,9 @@ import Data.Coerce #endif +asLazy :: StateT s m a -> Lazy.StateT s m a+asLazy = Lazy.StateT . runStateT+ --import qualified Control.Foldl as L  {-| Efficient representation of a left map-with-accumulator that preserves the@@ -388,7 +392,9 @@  -- | Apply a strict left 'Scan' to a 'Traversable' container scan :: Traversable t => Scan a b -> t a -> t b-scan (Scan step begin) as = fst $ runState (traverse step as) begin+-- To make it possible to consume the generated structure lazily, we must+-- 'traverse' with lazy 'StateT'.+scan (Scan step begin) as = fst $ Lazy.runState (traverse (asLazy . step) as) begin {-# INLINE scan #-}  -- | Like 'scan' but start scanning from the right@@ -399,7 +405,9 @@  -- | Like 'scan' but monadic scanM :: (Traversable t, Monad m) => ScanM m a b -> t a -> m (t b)-scanM (ScanM step begin) as = fmap fst $ runStateT (traverse step as) =<< begin+-- To make it possible to consume the generated structure lazily, we must+-- 'traverse' with lazy 'StateT'.+scanM (ScanM step begin) as = fmap fst $ Lazy.runStateT (traverse (asLazy . step) as) =<< begin {-# INLINE scanM #-}  {-| Convert a `Fold` into a prescan