Skip to content

Implement foldMap1 for NonEmpty in terms of foldr#195

Merged
vrom911 merged 2 commits intokowainik:masterfrom
josephcsible:foldmap1ne
Sep 22, 2019
Merged

Implement foldMap1 for NonEmpty in terms of foldr#195
vrom911 merged 2 commits intokowainik:masterfrom
josephcsible:foldmap1ne

Conversation

@josephcsible
Copy link
Copy Markdown
Contributor

@josephcsible josephcsible commented Sep 21, 2019 •
edited
Loading

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 chshersh added refactoring enhancement New feature or request labels Sep 21, 2019
chshersh
chshersh reviewed Sep 21, 2019
View reviewed changes
chshersh
chshersh approved these changes Sep 21, 2019
View reviewed changes
Copy link
Copy Markdown
Contributor

@chshersh chshersh left a comment

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Thanks!

chshersh
chshersh reviewed Sep 22, 2019
View reviewed changes
vrom911
vrom911 approved these changes Sep 22, 2019
View reviewed changes
Copy link
Copy Markdown
Member

@vrom911 vrom911 left a comment

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Thanks!

@vrom911 vrom911 merged commit a34772f into kowainik:master Sep 22, 2019
@josephcsible josephcsible deleted the foldmap1ne branch September 22, 2019 19:00
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment

Reviewers

@vrom911 vrom911 vrom911 approved these changes

+1 more reviewer

@chshersh chshersh chshersh approved these changes

Reviewers whose approvals may not affect merge requirements

Assignees

@josephcsible josephcsible

Labels

enhancement New feature or request refactoring

Projects

None yet

Milestone

No milestone

Development

Successfully merging this pull request may close these issues.

3 participants

@josephcsible @chshersh @vrom911