ADPfusion-0.5.2.0: tests/BacktrackingStructures.hs

{-# 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
    ]