worker/wrapper

foldm.hs

{-# OPTIONS_GHC -fstatic-argument-transformation #-}

module Main (main) where

import Criterion.Main
import Control.Monad
import Data.List
import Data.Functor.Identity

foldM' :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM' f z (x:xs) = f z x >>= \r -> foldM' f r xs
foldM' f z []     = return z
-- Это нужно закомментировать - иначе GHC 7.0 экспоненциально расходует память, ну и не компилирует ничего.
-- {-# INLINE foldM' #-}

foldMGo :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldMGo f z ys = go z ys
  where go a (x:xs) = f a x >>= \r -> go r xs
        go a []     = return a
{-# INLINE foldMGo #-}

main :: IO ()
main = defaultMain
    [ bench "bigsum-foldM" $ whnf (\i -> (runIdentity $ foldM (\a b -> return $! a + b) i [1..1000 :: Int])) 0
    , bench "bigsum-foldM'" $ whnf (\i -> (runIdentity $ foldM' (\a b -> return $! a + b) i [1..1000 :: Int])) 0
    , bench "bigsum-foldMGo" $ whnf (\i -> (runIdentity $ foldMGo (\a b -> return $! a + b) i [1..1000 :: Int])) 0
    , bench "bigsum-pure" $ whnf (\i -> foldl' (+) i [1..1000 :: Int]) 0
    ]

--benchmarking bigsum-foldM
--mean: 30.34575 us, lb 30.20558 us, ub 30.50929 us, ci 0.950
--std dev: 1.219805 us, lb 1.050039 us, ub 1.361802 us, ci 0.950
--
--benchmarking bigsum-foldM'
--mean: 4.289222 us, lb 4.264653 us, ub NaN s, ci 0.950
--std dev: 146.1354 ns, lb 125.9622 ns, ub 160.0729 ns, ci 0.950
--
--benchmarking bigsum-foldMGo
--mean: 4.689789 us, lb 4.649039 us, ub 4.726835 us, ci 0.950
--std dev: 176.3742 ns, lb 163.3153 ns, ub 181.5960 ns, ci 0.950
--
--benchmarking bigsum-pure
--mean: 4.327834 us, lb 4.299752 us, ub 4.352401 us, ci 0.950
--std dev: 165.8720 ns, lb 161.6608 ns, ub 174.1078 ns, ci 0.950