[commit: nofib] master: Add the binary-trees shootout benchmark (f8f27b8)
Johan Tibell
johan.tibell at gmail.com
Tue Feb 5 22:23:38 CET 2013
Repository : ssh://darcs.haskell.org//srv/darcs/nofib
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/f8f27b8b8b41a55e30cafd5b2189a403242eb185
>---------------------------------------------------------------
commit f8f27b8b8b41a55e30cafd5b2189a403242eb185
Author: Johan Tibell <johan.tibell at gmail.com>
Date: Tue Feb 5 13:01:52 2013 -0800
Add the binary-trees shootout benchmark
>---------------------------------------------------------------
.gitignore | 1 +
shootout/Makefile | 2 +-
shootout/binary-trees/Main.hs | 74 ++++++++++++++++++++
shootout/{fannkuch-redux => binary-trees}/Makefile | 9 ++-
shootout/binary-trees/binary-trees.faststdout | 7 ++
shootout/binary-trees/binary-trees.slowstdout | 11 +++
shootout/binary-trees/binary-trees.stdout | 9 +++
7 files changed, 108 insertions(+), 5 deletions(-)
diff --git a/.gitignore b/.gitignore
index 32e5c30..8d0effb 100644
--- a/.gitignore
+++ b/.gitignore
@@ -51,6 +51,7 @@ real/scs/scs
real/symalg/symalg
real/veritas/veritas
+shootout/binary-trees/binary-trees
shootout/fannkuch-redux/fannkuch-redux
shootout/pidigits/pidigits
shootout/spectral-norm/spectral-norm
diff --git a/shootout/Makefile b/shootout/Makefile
index fe0072a..16733c9 100644
--- a/shootout/Makefile
+++ b/shootout/Makefile
@@ -1,7 +1,7 @@
TOP = ..
include $(TOP)/mk/boilerplate.mk
-SUBDIRS = fannkuch-redux pidigits spectral-norm
+SUBDIRS = binary-trees fannkuch-redux pidigits spectral-norm
include $(TOP)/mk/target.mk
diff --git a/shootout/binary-trees/Main.hs b/shootout/binary-trees/Main.hs
new file mode 100644
index 0000000..7912dd4
--- /dev/null
+++ b/shootout/binary-trees/Main.hs
@@ -0,0 +1,74 @@
+--
+-- The Computer Language Benchmarks Game
+-- http://benchmarksgame.alioth.debian.org/
+--
+-- Contributed by Don Stewart
+-- Parallelized by Louis Wasserman
+
+import System.Environment
+import Control.Monad
+import System.Mem
+import Data.Bits
+import Text.Printf
+import GHC.Conc
+
+--
+-- an artificially strict tree.
+--
+-- normally you would ensure the branches are lazy, but this benchmark
+-- requires strict allocation.
+--
+data Tree = Nil | Node !Int !Tree !Tree
+
+minN = 4
+
+io s n t = printf "%s of depth %d\t check: %d\n" s n t
+
+main = do
+ n <- getArgs >>= readIO . head
+ let maxN = max (minN + 2) n
+ stretchN = maxN + 1
+ -- stretch memory tree
+ let c = {-# SCC "stretch" #-} check (make 0 stretchN)
+ io "stretch tree" stretchN c
+
+ -- allocate a long lived tree
+ let !long = make 0 maxN
+
+ -- allocate, walk, and deallocate many bottom-up binary trees
+ let vs = depth minN maxN
+ mapM_ (\((m,d,i)) -> io (show m ++ "\t trees") d i) vs
+
+ -- confirm the the long-lived binary tree still exists
+ io "long lived tree" maxN (check long)
+
+-- generate many trees
+depth :: Int -> Int -> [(Int,Int,Int)]
+depth d m
+ | d <= m = let
+ s = sumT d n 0
+ rest = depth (d+2) m
+ in s `par` ((2*n,d,s) : rest)
+ | otherwise = []
+ where n = bit (m - d + minN)
+
+-- allocate and check lots of trees
+sumT :: Int -> Int -> Int -> Int
+sumT d 0 t = t
+sumT d i t = a `par` b `par` sumT d (i-1) ans
+ where a = check (make i d)
+ b = check (make (-i) d)
+ ans = a + b + t
+
+check = check' True 0
+
+-- traverse the tree, counting up the nodes
+check' :: Bool -> Int -> Tree -> Int
+check' !b !z Nil = z
+check' b z (Node i l r) = check' (not b) (check' b (if b then z+i else z-i) l) r
+
+-- build a tree
+make :: Int -> Int -> Tree
+make i 0 = Node i Nil Nil
+make i d = Node i (make (i2-1) d2) (make i2 d2)
+ where i2 = 2*i; d2 = d-1
diff --git a/shootout/fannkuch-redux/Makefile b/shootout/binary-trees/Makefile
similarity index 53%
copy from shootout/fannkuch-redux/Makefile
copy to shootout/binary-trees/Makefile
index facb262..8a27f6d 100644
--- a/shootout/fannkuch-redux/Makefile
+++ b/shootout/binary-trees/Makefile
@@ -2,10 +2,11 @@ TOP = ../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/target.mk
-FAST_OPTS = 10
-NORM_OPTS = 11
-SLOW_OPTS = 12 # official shootout setting
+FAST_OPTS = 12
+NORM_OPTS = 16
+SLOW_OPTS = 20 # official shootout setting
# The benchmark game also uses -fllvm, which we can't since it might
# not be available on the developer's machine.
-HC_OPTS += -XBangPatterns -O2
+HC_OPTS += -XBangPatterns -O2 -funbox-strict-fields
+SRC_RUNTEST_OPTS += +RTS -K128M -H -RTS
diff --git a/shootout/binary-trees/binary-trees.faststdout b/shootout/binary-trees/binary-trees.faststdout
new file mode 100644
index 0000000..9dfe135
--- /dev/null
+++ b/shootout/binary-trees/binary-trees.faststdout
@@ -0,0 +1,7 @@
+stretch tree of depth 13 check: -1
+8192 trees of depth 4 check: -8192
+2048 trees of depth 6 check: -2048
+512 trees of depth 8 check: -512
+128 trees of depth 10 check: -128
+32 trees of depth 12 check: -32
+long lived tree of depth 12 check: -1
diff --git a/shootout/binary-trees/binary-trees.slowstdout b/shootout/binary-trees/binary-trees.slowstdout
new file mode 100644
index 0000000..897eba5
--- /dev/null
+++ b/shootout/binary-trees/binary-trees.slowstdout
@@ -0,0 +1,11 @@
+stretch tree of depth 21 check: -1
+2097152 trees of depth 4 check: -2097152
+524288 trees of depth 6 check: -524288
+131072 trees of depth 8 check: -131072
+32768 trees of depth 10 check: -32768
+8192 trees of depth 12 check: -8192
+2048 trees of depth 14 check: -2048
+512 trees of depth 16 check: -512
+128 trees of depth 18 check: -128
+32 trees of depth 20 check: -32
+long lived tree of depth 20 check: -1
diff --git a/shootout/binary-trees/binary-trees.stdout b/shootout/binary-trees/binary-trees.stdout
new file mode 100644
index 0000000..696bd5c
--- /dev/null
+++ b/shootout/binary-trees/binary-trees.stdout
@@ -0,0 +1,9 @@
+stretch tree of depth 17 check: -1
+131072 trees of depth 4 check: -131072
+32768 trees of depth 6 check: -32768
+8192 trees of depth 8 check: -8192
+2048 trees of depth 10 check: -2048
+512 trees of depth 12 check: -512
+128 trees of depth 14 check: -128
+32 trees of depth 16 check: -32
+long lived tree of depth 16 check: -1
More information about the ghc-commits
mailing list