mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 11:50:28 +02:00
22ec6a31ed
* 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.
103 lines
3.2 KiB
Scheme
103 lines
3.2 KiB
Scheme
;;; -*- 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)))))))
|