Implement foldMap1 for NonEmpty in terms of foldr

[josephcsible]

This is a big performance win.

My test program:

{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}

import Control.Monad (when)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Monoid (All(..), Sum(..))
import System.Environment (getArgs)

foldMap1_old :: Semigroup m => (a -> m) -> NonEmpty a -> m
foldMap1_old f (a :| [])     = f a
foldMap1_old f (a :| b : bs) = f a <> foldMap1_old f (b :| bs)

foldMap1_new :: forall m a . Semigroup m => (a -> m) -> NonEmpty a -> m
foldMap1_new f (a :| as) = foldr go f as a
  where
    go :: a -> (a -> m) -> a -> m
    go b g x = f x <> g b

testFoldMap1 :: (forall m a. Semigroup m => (a -> m) -> NonEmpty a -> m) -> IO ()
testFoldMap1 foldMap1 = do
  print $ foldMap1 (:[]) (0 :| [1..10])
  print $ foldMap1 All (True :| replicate 50000000 True)
  print $ foldMap1 All (True :| replicate 50000000 True ++ [False])
  print $ foldMap1 Sum (0 :| [1..50000000])

main :: IO ()
main = do
  args <- getArgs
  when ("old" `elem` args) $ do
    putStrLn "Using the old variant"
    testFoldMap1 foldMap1_old
  when ("new" `elem` args) $ do
    putStrLn "Using the new variant"
    testFoldMap1 foldMap1_new

And the results:

$ ghc -O foldMap1.hs
[1 of 1] Compiling Main             ( foldMap1.hs, foldMap1.o )
Linking foldMap1 ...
$ GHCRTS=-s ./foldMap1 old
Using the old variant
[0,1,2,3,4,5,6,7,8,9,10]
All {getAll = True}
All {getAll = False}
Sum {getSum = 1250000025000000}
  23,276,644,208 bytes allocated in the heap
  19,795,671,872 bytes copied during GC
   5,355,137,232 bytes maximum residency (15 sample(s))
      51,103,536 bytes maximum slop
            5107 MB total memory in use (0 MB lost due to fragmentation)

                                     Tot time (elapsed)  Avg pause  Max pause
  Gen  0     20280 colls,     0 par    5.368s   5.369s     0.0003s    0.0014s
  Gen  1        15 colls,     0 par    6.957s   6.958s     0.4639s    3.2021s

  INIT    time    0.000s  (  0.000s elapsed)
  MUT     time    3.763s  (  3.762s elapsed)
  GC      time   12.325s  ( 12.327s elapsed)
  EXIT    time    0.000s  (  0.000s elapsed)
  Total   time   16.089s  ( 16.090s elapsed)

  %GC     time       0.0%  (0.0% elapsed)

  Alloc rate    6,186,106,961 bytes per MUT second

  Productivity  23.4% of total user, 23.4% of total elapsed

$ GHCRTS=-s ./foldMap1 new
Using the new variant
[0,1,2,3,4,5,6,7,8,9,10]
All {getAll = True}
All {getAll = False}
Sum {getSum = 1250000025000000}
  22,076,644,216 bytes allocated in the heap
  11,250,825,832 bytes copied during GC
   2,988,248,864 bytes maximum residency (15 sample(s))
       5,353,696 bytes maximum slop
            2849 MB total memory in use (0 MB lost due to fragmentation)

                                     Tot time (elapsed)  Avg pause  Max pause
  Gen  0     19214 colls,     0 par    4.320s   4.319s     0.0002s    0.0023s
  Gen  1        15 colls,     0 par    3.477s   3.478s     0.2318s    1.4489s

  INIT    time    0.000s  (  0.000s elapsed)
  MUT     time    4.096s  (  4.097s elapsed)
  GC      time    7.797s  (  7.797s elapsed)
  EXIT    time    0.000s  (  0.000s elapsed)
  Total   time   11.894s  ( 11.894s elapsed)

  %GC     time       0.0%  (0.0% elapsed)

  Alloc rate    5,389,230,580 bytes per MUT second

  Productivity  34.4% of total user, 34.4% of total elapsed

$ 

Checklist:

HLint

• I've changed the exposed interface (add new reexports, remove reexports, rename reexported things, etc.).
  • I've updated hlint.dhall accordingly to my changes (add new rules for the new imports, remove old ones, when they are outdated, etc.).
  • I've generated the new .hlint.yaml file (see this instructions).

General

• I've updated the CHANGELOG with the short description of my latest changes.
• All new and existing tests pass.
• I keep the code style used in the files I've changed (see style-guide for more details).
• I've used the stylish-haskell file.
• My change requires the documentation updates.
  • I've updated the documentation accordingly.
• I've added the [ci skip] text to the docs-only related commit's name.

[chshersh]

Thanks!

[vrom911]

Thanks!