Commit 05c1364c authored by Ben Gamari's avatar Ben Gamari 🐢
Browse files

collectArgs benchmarks

parent d2b2a6fd
{-# LANGUAGE BangPatterns #-}
import qualified Data.DList as DList
import qualified Data.Sequence as Seq
import Control.DeepSeq
import Data.Foldable
import Criterion.Main
data Expr = App Expr Expr
| Var Int
deriving (Show)
instance NFData Expr where
rnf (App a b) = rnf a `seq` rnf b
rnf (Var a) = rnf a
appChain :: Int -> Expr
appChain = go
where
go 0 = Var 0
go n = go (n-1) `App` (Var n)
collectArgs_Seq :: Expr -> (Expr, Seq.Seq Expr)
collectArgs_Seq = go mempty
where
go :: Seq.Seq Expr -> Expr -> (Expr, Seq.Seq Expr)
go acc (App a b) = go (acc Seq.|> b) a
go acc a = (a, acc)
collectArgs_List :: Expr -> (Expr, [Expr])
collectArgs_List = go mempty
where
go :: [Expr] -> Expr -> (Expr, [Expr])
go acc (App a b) = go (b:acc) a
go acc a = (a, reverse acc)
collectArgs_DList :: Expr -> (Expr, [Expr])
collectArgs_DList = go mempty
where
go :: DList.DList Expr -> Expr -> (Expr, [Expr])
go acc (App a b) = go (acc <> DList.singleton b) a
go acc a = (a, toList acc)
collectArgs_OnStack :: Expr -> (Expr, [Expr])
collectArgs_OnStack = go
where
go :: Expr -> (Expr, [Expr])
go (App a b) =
let !(e', as) = go a
in (e', b:as)
go a = (a, [])
collectArgsBenchmarks :: Int -> Benchmark
collectArgsBenchmarks len = bgroup ("length="++show len)
[ bench "sequence" $ nf (collectArgs_Seq) xs
, bench "dlist" $ nf (collectArgs_DList) xs
, bench "list" $ nf (collectArgs_List) xs
, bench "list" $ nf (collectArgs_OnStack) xs
]
where
xs = appChain len
rebuildSeq :: [a] -> Seq.Seq a
rebuildSeq = go mempty
where
......@@ -25,7 +83,6 @@ rebuildDList = go mempty
go acc (x:xs) = go (acc <> DList.singleton x) xs
go acc [] = toList acc
rebuildBenchmarks :: Int -> Benchmark
rebuildBenchmarks len = bgroup ("length="++show len)
[ bench "sequence" $ whnf (length . rebuildSeq) xs
......@@ -35,14 +92,9 @@ rebuildBenchmarks len = bgroup ("length="++show len)
where
xs = [1..len]
lengths = [1,2,5,10,20,50,100,200]
main :: IO ()
main = defaultMain
[ rebuildBenchmarks 1
, rebuildBenchmarks 2
, rebuildBenchmarks 5
, rebuildBenchmarks 10
, rebuildBenchmarks 20
, rebuildBenchmarks 50
, rebuildBenchmarks 100
, rebuildBenchmarks 200
[ bgroup "rebuild" $ map rebuildBenchmarks lengths
, bgroup "collectArgs" $ map collectArgsBenchmarks lengths
]
......@@ -14,6 +14,7 @@ extra-source-files: CHANGELOG.md
executable append-benchmark
main-is: Main.hs
build-depends: base >=4.13 && <4.14,
deepseq,
containers,
dlist,
criterion
......
No preview for this file type
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment