|
Packit |
368400 |
{-# LANGUAGE RankNTypes, BangPatterns #-}
|
|
Packit |
368400 |
-- Compare low-level, fused, unfused, and partially fused
|
|
Packit |
368400 |
import Data.Conduit
|
|
Packit |
368400 |
import qualified Data.Conduit.List as CL
|
|
Packit |
368400 |
import Data.Conduit.Internal (Step (..), Stream (..), unstream, StreamConduit (..))
|
|
Packit |
368400 |
import Criterion.Main
|
|
Packit |
368400 |
import Data.Functor.Identity (runIdentity)
|
|
Packit |
368400 |
|
|
Packit |
368400 |
-- | unfused
|
|
Packit |
368400 |
enumFromToC :: (Eq a, Monad m, Enum a) => a -> a -> Producer m a
|
|
Packit |
368400 |
enumFromToC x0 y =
|
|
Packit |
368400 |
loop x0
|
|
Packit |
368400 |
where
|
|
Packit |
368400 |
loop x
|
|
Packit |
368400 |
| x == y = yield x
|
|
Packit |
368400 |
| otherwise = yield x >> loop (succ x)
|
|
Packit |
368400 |
{-# INLINE enumFromToC #-}
|
|
Packit |
368400 |
|
|
Packit |
368400 |
-- | unfused
|
|
Packit |
368400 |
mapC :: Monad m => (a -> b) -> Conduit a m b
|
|
Packit |
368400 |
mapC f = awaitForever $ yield . f
|
|
Packit |
368400 |
{-# INLINE mapC #-}
|
|
Packit |
368400 |
|
|
Packit |
368400 |
-- | unfused
|
|
Packit |
368400 |
foldC :: Monad m => (b -> a -> b) -> b -> Consumer a m b
|
|
Packit |
368400 |
foldC f =
|
|
Packit |
368400 |
loop
|
|
Packit |
368400 |
where
|
|
Packit |
368400 |
loop !b = await >>= maybe (return b) (loop . f b)
|
|
Packit |
368400 |
{-# INLINE foldC #-}
|
|
Packit |
368400 |
|
|
Packit |
368400 |
main :: IO ()
|
|
Packit |
368400 |
main = defaultMain
|
|
Packit |
368400 |
[ bench "low level" $ flip whnf upper0 $ \upper ->
|
|
Packit |
368400 |
let loop x t
|
|
Packit |
368400 |
| x > upper = t
|
|
Packit |
368400 |
| otherwise = loop (x + 1) (t + ((x * 2) + 1))
|
|
Packit |
368400 |
in loop 1 0
|
|
Packit |
368400 |
, bench "completely fused" $ flip whnf upper0 $ \upper ->
|
|
Packit |
368400 |
runIdentity
|
|
Packit |
368400 |
$ CL.enumFromTo 1 upper
|
|
Packit |
368400 |
$$ CL.map (* 2)
|
|
Packit |
368400 |
=$ CL.map (+ 1)
|
|
Packit |
368400 |
=$ CL.fold (+) 0
|
|
Packit |
368400 |
, bench "runConduit, completely fused" $ flip whnf upper0 $ \upper ->
|
|
Packit |
368400 |
runIdentity
|
|
Packit |
368400 |
$ runConduit
|
|
Packit |
368400 |
$ CL.enumFromTo 1 upper
|
|
Packit |
368400 |
=$= CL.map (* 2)
|
|
Packit |
368400 |
=$= CL.map (+ 1)
|
|
Packit |
368400 |
=$= CL.fold (+) 0
|
|
Packit |
368400 |
, bench "completely unfused" $ flip whnf upper0 $ \upper ->
|
|
Packit |
368400 |
runIdentity
|
|
Packit |
368400 |
$ enumFromToC 1 upper
|
|
Packit |
368400 |
$$ mapC (* 2)
|
|
Packit |
368400 |
=$ mapC (+ 1)
|
|
Packit |
368400 |
=$ foldC (+) 0
|
|
Packit |
368400 |
, bench "beginning fusion" $ flip whnf upper0 $ \upper ->
|
|
Packit |
368400 |
runIdentity
|
|
Packit |
368400 |
$ (CL.enumFromTo 1 upper $= CL.map (* 2))
|
|
Packit |
368400 |
$$ mapC (+ 1)
|
|
Packit |
368400 |
=$ foldC (+) 0
|
|
Packit |
368400 |
, bench "middle fusion" $ flip whnf upper0 $ \upper ->
|
|
Packit |
368400 |
runIdentity
|
|
Packit |
368400 |
$ enumFromToC 1 upper
|
|
Packit |
368400 |
$$ (CL.map (* 2) =$= CL.map (+ 1))
|
|
Packit |
368400 |
=$ foldC (+) 0
|
|
Packit |
368400 |
, bench "ending fusion" $ flip whnf upper0 $ \upper ->
|
|
Packit |
368400 |
runIdentity
|
|
Packit |
368400 |
$ enumFromToC 1 upper
|
|
Packit |
368400 |
$= mapC (* 2)
|
|
Packit |
368400 |
$$ (CL.map (+ 1) =$ CL.fold (+) 0)
|
|
Packit |
368400 |
, bench "performance of CL.enumFromTo without fusion" $ flip whnf upper0 $ \upper ->
|
|
Packit |
368400 |
runIdentity
|
|
Packit |
368400 |
$ CL.enumFromTo 1 upper
|
|
Packit |
368400 |
$= mapC (* 2)
|
|
Packit |
368400 |
$$ (CL.map (+ 1) =$ CL.fold (+) 0)
|
|
Packit |
368400 |
]
|
|
Packit |
368400 |
where
|
|
Packit |
368400 |
upper0 = 100000 :: Int
|