benchmark-suite/benchmarks/vlists.bm

   1 ;;; -*- mode: scheme; coding: iso-8859-1; -*-
   2 ;;; VLists.
   3 ;;;
   4 ;;; Copyright 2009 Free Software Foundation, Inc.
   5 ;;;
   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.
  10 ;;;
  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.
  15 ;;;
  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
  20
  21 (define-module (benchmarks vlists)
  22   :use-module (srfi srfi-1)
  23   :use-module (ice-9 vlist)
  24   :use-module (benchmark-suite lib))
  25
  26 ;; Note: Use `--iteration-factor' to change this.
  27 (define iterations 2000000)
  28
  29 ;; The size of large lists.
  30 (define %list-size 700000)
  31
  32 (define %big-list (make-list %list-size))
  33 (define %big-vlist (list->vlist %big-list))
  34
  35 (define-syntax comparative-benchmark
  36   (syntax-rules ()
  37     ((_ benchmark-name iterations
  38         ((api ((name value) ...)))
  39         body ...)
  40      (benchmark (format #f "~A (~A)" benchmark-name 'api)
  41                 iterations
  42                 (let ((name value) ...)
  43                   body ...)))
  44     ((_ benchmark-name iterations
  45         ((api bindings) apis ...)
  46         body ...)
  47      (begin
  48        (comparative-benchmark benchmark-name iterations
  49                               ((api bindings))
  50                               body ...)
  51        (comparative-benchmark benchmark-name iterations
  52                               (apis ...)
  53                               body ...)))))
  54
  55 \f
  56 (with-benchmark-prefix "constructors"
  57
  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)
  62                (r null))
  63          (and (> i 0)
  64               (loop (1- i) (cons #t r)))))
  65
  66
  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)
  71                (r null))
  72       (if (zero? i)
  73           r
  74           (loop (1- i) (acons i i r))))))
  75
  76 \f
  77 (define %big-alist
  78   (let loop ((i %list-size) (res '()))
  79     (if (zero? i)
  80         res
  81         (loop (1- i) (alist-cons i i res)))))
  82 (define %big-vhash
  83   (let loop ((i %list-size) (res vlist-null))
  84     (if (zero? i)
  85         res
  86         (loop (1- i) (vhash-cons i i res)))))
  87
  88
  89 (with-benchmark-prefix "iteration"
  90
  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))
  95
  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)))
 100       (and (> i 0)
 101            (begin
 102              (assoc i alst)
 103              (loop (- i 5000)))))))