summaryrefslogtreecommitdiff
path: root/benchmark-suite
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2010-02-02 23:57:02 +0100
committerLudovic Courtès <ludo@gnu.org>2010-02-03 00:02:14 +0100
commit22ec6a31eda1f06270fbba4b6aae45bb81de0631 (patch)
treee551ce5b8c1cf2a7de3ac866e1b3bcdae18ee09a /benchmark-suite
parent30a700c8c12aeaefe3cd5fb85ea3c1b7059705bf (diff)
Add `(ice-9 vlist)'.
* module/ice-9/vlist.scm, test-suite/tests/vlist.test, benchmark-suite/benchmarks/vlists.bm: New files. * module/Makefile.am (ICE_9_SOURCES): Add `vlist.scm'. * test-suite/Makefile.am (SCM_TESTS): Add `tests/vlist.test'. * benchmark-suite/Makefile.am (SCM_BENCHMARKS): Add `benchmarks/vlists.bm'. * doc/ref/api-compound.texi (VLists, VHashes): New nodes.
Diffstat (limited to 'benchmark-suite')
-rw-r--r--benchmark-suite/Makefile.am3
-rw-r--r--benchmark-suite/benchmarks/vlists.bm103
2 files changed, 105 insertions, 1 deletions
diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am
index a9da00e72..583519a38 100644
--- a/benchmark-suite/Makefile.am
+++ b/benchmark-suite/Makefile.am
@@ -7,7 +7,8 @@ SCM_BENCHMARKS = benchmarks/0-reference.bm \
benchmarks/structs.bm \
benchmarks/subr.bm \
benchmarks/uniform-vector-read.bm \
- benchmarks/vectors.bm
+ benchmarks/vectors.bm \
+ benchmarks/vlists.bm
EXTRA_DIST = guile-benchmark lib.scm $(SCM_BENCHMARKS) \
ChangeLog-2008
diff --git a/benchmark-suite/benchmarks/vlists.bm b/benchmark-suite/benchmarks/vlists.bm
new file mode 100644
index 000000000..329c78623
--- /dev/null
+++ b/benchmark-suite/benchmarks/vlists.bm
@@ -0,0 +1,103 @@
+;;; -*- mode: scheme; coding: iso-8859-1; -*-
+;;; VLists.
+;;;
+;;; Copyright 2009 Free Software Foundation, Inc.
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public License
+;;; as published by the Free Software Foundation; either version 3, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this software; see the file COPYING.LESSER. If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks vlists)
+ :use-module (srfi srfi-1)
+ :use-module (ice-9 vlist)
+ :use-module (benchmark-suite lib))
+
+;; Note: Use `--iteration-factor' to change this.
+(define iterations 2000000)
+
+;; The size of large lists.
+(define %list-size 700000)
+
+(define %big-list (make-list %list-size))
+(define %big-vlist (list->vlist %big-list))
+
+(define-syntax comparative-benchmark
+ (syntax-rules ()
+ ((_ benchmark-name iterations
+ ((api ((name value) ...)))
+ body ...)
+ (benchmark (format #f "~A (~A)" benchmark-name 'api)
+ iterations
+ (let ((name value) ...)
+ body ...)))
+ ((_ benchmark-name iterations
+ ((api bindings) apis ...)
+ body ...)
+ (begin
+ (comparative-benchmark benchmark-name iterations
+ ((api bindings))
+ body ...)
+ (comparative-benchmark benchmark-name iterations
+ (apis ...)
+ body ...)))))
+
+
+(with-benchmark-prefix "constructors"
+
+ (comparative-benchmark "cons" 2
+ ((srfi-1 ((cons cons) (null '())))
+ (vlist ((cons vlist-cons) (null vlist-null))))
+ (let loop ((i %list-size)
+ (r null))
+ (and (> i 0)
+ (loop (1- i) (cons #t r)))))
+
+
+ (comparative-benchmark "acons" 2
+ ((srfi-1 ((acons alist-cons) (null '())))
+ (vlist ((acons vhash-cons) (null vlist-null))))
+ (let loop ((i %list-size)
+ (r null))
+ (if (zero? i)
+ r
+ (loop (1- i) (acons i i r))))))
+
+
+(define %big-alist
+ (let loop ((i %list-size) (res '()))
+ (if (zero? i)
+ res
+ (loop (1- i) (alist-cons i i res)))))
+(define %big-vhash
+ (let loop ((i %list-size) (res vlist-null))
+ (if (zero? i)
+ res
+ (loop (1- i) (vhash-cons i i res)))))
+
+
+(with-benchmark-prefix "iteration"
+
+ (comparative-benchmark "fold" 2
+ ((srfi-1 ((fold fold) (lst %big-list)))
+ (vlist ((fold vlist-fold) (lst %big-vlist))))
+ (fold (lambda (x y) y) #t lst))
+
+ (comparative-benchmark "assoc" 70
+ ((srfi-1 ((assoc assoc) (alst %big-alist)))
+ (vhash ((assoc vhash-assoc) (alst %big-vhash))))
+ (let loop ((i (quotient %list-size 3)))
+ (and (> i 0)
+ (begin
+ (assoc i alst)
+ (loop (- i 5000)))))))