benchmark-suite/benchmarks/arithmetic.bm

   1 ;;; -*- mode: scheme; coding: utf-8; -*-
   2 ;;; Integer arithmetic.
   3 ;;;
   4 ;;; Copyright 2010 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 arithmetic)
  22   #:use-module (benchmark-suite lib))
  23
  24 (define-syntax repeat
  25   (lambda (s)
  26     ;; Construct an expression of the form `(OP (OP (OP SEED)))', with a
  27     ;; depth of COUNT.
  28     (syntax-case s (<>)
  29       ((_ (op x <>) seed count) ;; binary OP
  30        (number? (syntax->datum #'count))
  31        (let loop ((count  (syntax->datum #'count))
  32                   (result #'seed))
  33          (if (= 0 count)
  34              result
  35              (loop (1- count)
  36                    (with-syntax ((result result))
  37                      #'(op x result))))))
  38       ((_ (op <>) seed count)  ;; unary OP
  39        (number? (syntax->datum #'count))
  40        (let loop ((count  (syntax->datum #'count))
  41                   (result #'seed))
  42          (if (= 0 count)
  43              result
  44              (loop (1- count)
  45                    (with-syntax ((result result))
  46                      #'(op result)))))))))
  47
  48 \f
  49 (with-benchmark-prefix "fixnum"
  50
  51   (benchmark "1+" 1e7
  52     (repeat (1+ <>) 2 100))
  53
  54   (benchmark "1-" 1e7
  55     (repeat (1- <>) 2 100))
  56
  57   (benchmark "+" 1e7
  58     (repeat (+ 2 <>) 7 100))
  59
  60   (benchmark "-" 1e7
  61     (repeat (- 2 <>) 7 100))
  62
  63   (benchmark "*" 1e7
  64     (repeat (* 1 <>) 1 100))
  65
  66   (benchmark "/" 1e7
  67     (repeat (/ 2 <>) 1 100)))