guile-for-guile-emacs/benchmark-suite/benchmarks/vlists.bm

;;; -*- 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)))))))