{-# Language MagicHash #-}
module Main where
import Criterion.Main
import Data.Vector.Fusion.Stream.Monadic (Stream,foldl',mapM_)
import Data.Vector.Fusion.Util
import Data.Vector.Unboxed (Vector, fromList)
import GHC.Exts (inline, Int(..), (<=#) )
import Prelude hiding (mapM_)
import System.IO.Unsafe
import qualified Data.FMList as F
listLeft :: Int -> Int
listLeft k = sum $ go k []
where go 0 xs = xs
go k xs = go (k-1) (k:xs)
{-# NoInline listLeft #-}
listRight :: Int -> Int
listRight k = sum $ go k []
where go 0 xs = xs
go k xs = go (k-1) (xs++[k])
{-# NoInline listRight #-}
listRightRev :: Int -> Int
listRightRev k = sum . reverse $ go k []
where go 0 xs = xs
go k xs = go (k-1) (k:xs)
{-# NoInline listRightRev #-}
listBoth :: Int -> Int
listBoth k = sum $ go (k `div` 2) []
where go 0 xs = xs
go k xs = go (k-1) (k:xs++[k])
{-# NoInline listBoth #-}
fmLeft :: Int -> Int
fmLeft k = sum . F.toList $ go k F.empty
where go 0 xs = xs
go k xs = go (k-1) (k `F.cons` xs)
{-# NoInline fmLeft #-}
fmRight :: Int -> Int
fmRight k = sum . F.toList $ go k F.empty
where go 0 xs = xs
go k xs = go (k-1) (xs `F.snoc` k)
{-# NoInline fmRight #-}
-- |
benchWithK s k =
bgroup s
[ bench "listLeft" $ whnf listLeft k
, bench "listRight" $ whnf listRight k
, bench "listRightRev" $ whnf listRight k
, bench "listBoth" $ whnf listBoth k
, bench "fmLeft" $ whnf fmLeft k
, bench "fmRight" $ whnf fmRight k
]
{-# Inline benchWithK #-}
-- |
main :: IO ()
main = do
defaultMain
[ benchWithK "10" 10
, benchWithK "20" 20
, benchWithK "100" 100
, benchWithK "1000" 1000
]