1 ;;; -*- mode: scheme; coding: iso-8859-1; -*-
4 ;;; Copyright 2009 Free Software Foundation, Inc.
6 ;;; This program is free software; you can redistribute it and/or
7 ;;; modify it under the terms of the GNU Lesser General Public License
8 ;;; as published by the Free Software Foundation; either version 3, or
9 ;;; (at your option) any later version.
11 ;;; This program is distributed in the hope that it will be useful,
12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;; GNU Lesser General Public License for more details.
16 ;;; You should have received a copy of the GNU Lesser General Public
17 ;;; License along with this software; see the file COPYING.LESSER. If
18 ;;; not, write to the Free Software Foundation, Inc., 51 Franklin
19 ;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
21 (define-module (benchmarks vlists)
22 :use-module (srfi srfi-1)
23 :use-module (ice-9 vlist)
24 :use-module (benchmark-suite lib))
26 ;; Note: Use `--iteration-factor' to change this.
27 (define iterations 2000000)
29 ;; The size of large lists.
30 (define %list-size 700000)
32 (define %big-list (make-list %list-size))
33 (define %big-vlist (list->vlist %big-list))
35 (define-syntax comparative-benchmark
37 ((_ benchmark-name iterations
38 ((api ((name value) ...)))
40 (benchmark (format #f "~A (~A)" benchmark-name 'api)
42 (let ((name value) ...)
44 ((_ benchmark-name iterations
45 ((api bindings) apis ...)
48 (comparative-benchmark benchmark-name iterations
51 (comparative-benchmark benchmark-name iterations
56 (with-benchmark-prefix "constructors"
58 (comparative-benchmark "cons" 2
59 ((srfi-1 ((cons cons) (null '())))
60 (vlist ((cons vlist-cons) (null vlist-null))))
61 (let loop ((i %list-size)
64 (loop (1- i) (cons #t r)))))
67 (comparative-benchmark "acons" 2
68 ((srfi-1 ((acons alist-cons) (null '())))
69 (vlist ((acons vhash-cons) (null vlist-null))))
70 (let loop ((i %list-size)
74 (loop (1- i) (acons i i r))))))
78 (let loop ((i %list-size) (res '()))
81 (loop (1- i) (alist-cons i i res)))))
83 (let loop ((i %list-size) (res vlist-null))
86 (loop (1- i) (vhash-cons i i res)))))
89 (with-benchmark-prefix "iteration"
91 (comparative-benchmark "fold" 2
92 ((srfi-1 ((fold fold) (lst %big-list)))
93 (vlist ((fold vlist-fold) (lst %big-vlist))))
94 (fold (lambda (x y) y) #t lst))
96 (comparative-benchmark "assoc" 70
97 ((srfi-1 ((assoc assoc) (alst %big-alist)))
98 (vhash ((assoc vhash-assoc) (alst %big-vhash))))
99 (let loop ((i (quotient %list-size 3)))
103 (loop (- i 5000)))))))