From 22ec6a31eda1f06270fbba4b6aae45bb81de0631 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 2 Feb 2010 23:57:02 +0100
Subject: 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.
---
 benchmark-suite/Makefile.am          |   3 +-
 benchmark-suite/benchmarks/vlists.bm | 103 +++++++++++++++++++++++++++++++++++
 2 files changed, 105 insertions(+), 1 deletion(-)
 create mode 100644 benchmark-suite/benchmarks/vlists.bm

(limited to 'benchmark-suite')

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)))))))
-- 
cgit v1.2.1