+1<br><br><div class="gmail_quote"><div dir="ltr">On Fri, Jun 8, 2018, 7:10 AM Simon Jakobi via Libraries <<a href="mailto:libraries@haskell.org">libraries@haskell.org</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">I'm in favor of adding this to Foldable.<br>
<br>
2018-06-08 15:20 GMT+02:00 Andrew Martin <<a href="mailto:andrew.thaddeus@gmail.com" target="_blank">andrew.thaddeus@gmail.com</a>>:<br>
> I propose adding another method to the Foldable typeclass: foldMap'<br>
><br>
> This has the same behavior as foldMap except that it is strict in the<br>
> accumulator. This can lead to considerable performance gains when the user<br>
> knows that monoidal append is strict both arguments. Consider the following<br>
> example (available as a gist at<br>
> <a href="https://gist.github.com/andrewthad/f79b7022725532baf709514cf08c3955" rel="noreferrer" target="_blank">https://gist.github.com/andrewthad/f79b7022725532baf709514cf08c3955</a>):<br>
><br>
>   {-# LANGUAGE BangPatterns #-}<br>
>   {-# OPTIONS_GHC -O2 #-}<br>
>   import Gauge<br>
>   import Data.Foldable<br>
>   import qualified Data.Set as S<br>
><br>
>   foldMap' :: (Monoid m, Foldable f) => (a -> m) -> f a -> m<br>
>   foldMap' f = foldl' (\ !acc a -> acc <> f a) mempty<br>
><br>
>   numbers :: [Int]<br>
>   numbers = [1..4000]<br>
><br>
>   intToSet :: Int -> S.Set Int<br>
>   intToSet i = S.singleton (mod i 10)<br>
><br>
>   main :: IO ()<br>
>   main = defaultMain<br>
>     [ bench "lazy" $ whnf (foldMap intToSet) numbers<br>
>     , bench "strict" $ whnf (foldMap' intToSet) numbers<br>
>     ]<br>
><br>
> Here are the results we get from running this:<br>
><br>
>   benchmarked lazy<br>
>   time                 178.8 μs   (176.1 μs .. 183.1 μs)<br>
>                        0.996 R²   (0.993 R² .. 0.998 R²)<br>
>   mean                 180.8 μs   (179.1 μs .. 183.3 μs)<br>
>   std dev              7.242 μs   (5.856 μs .. 9.304 μs)<br>
>   variance introduced by outliers: 20% (moderately inflated)<br>
><br>
>   benchmarked strict<br>
>   time                 108.4 μs   (106.1 μs .. 111.0 μs)<br>
>                        0.997 R²   (0.996 R² .. 0.999 R²)<br>
>   mean                 107.9 μs   (107.0 μs .. 109.3 μs)<br>
>   std dev              3.672 μs   (2.451 μs .. 6.220 μs)<br>
>   variance introduced by outliers: 15% (moderately inflated)<br>
><br>
> These performance gains are considerable. It needs to be a method of<br>
> Foldable and not just a function written using foldl' for the same reason<br>
> that the lazy foldMap needs to be a method of Foldable. There are types for<br>
> which the default implementation can be improved upon. This is a<br>
> non-breaking change since there is a sensible default implementation.<br>
><br>
> --<br>
> -Andrew Thaddeus Martin<br>
><br>
> _______________________________________________<br>
> Libraries mailing list<br>
> <a href="mailto:Libraries@haskell.org" target="_blank">Libraries@haskell.org</a><br>
> <a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries</a><br>
><br>
_______________________________________________<br>
Libraries mailing list<br>
<a href="mailto:Libraries@haskell.org" target="_blank">Libraries@haskell.org</a><br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries</a><br>
</blockquote></div>