[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-163-g78d1be4

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=78d1be4aef408248bbb545d4b94b4b1335a4ab88

The branch, stable-2.0 has been updated
       via  78d1be4aef408248bbb545d4b94b4b1335a4ab88 (commit)
       via  b7715701b488a1de87c7767bc437a853f10001ee (commit)
      from  90fed973abf1d55212d7a43f8450f5fe76d9e6a2 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 78d1be4aef408248bbb545d4b94b4b1335a4ab88
Author: Andreas Rottmann <address@hidden>
Date:   Sat Apr 2 19:42:27 2011 +0200

    Several optimizations for R6RS fixnum arithmetic
    
    * module/rnrs/arithmetic/fixnums.scm (assert-fixnum): Is now a
      macro.
      (assert-fixnums): New procedure checking a the elements of a list
      for fixnum-ness.  All callers applying `assert-fixnum' to a list
      now changed to use this procedure.
    
    * module/rnrs/arithmetic/fixnums.scm (define-fxop*): New for defining
      n-ary inlinable special-casing the binary case using `case-lambda'.
      All applicable procedures redefined using this macro.
    
    * module/rnrs/arithmetic/fixnums.scm: Alias all predicates to
      their non-fixnum counterparts.

commit b7715701b488a1de87c7767bc437a853f10001ee
Author: Andreas Rottmann <address@hidden>
Date:   Sat Apr 2 19:42:26 2011 +0200

    Add a few benchmarks for R6RS fixnum arithmetic
    
    * benchmark-suite/benchmarks/r6rs-arithmetic.bm: New file containing
      some benchmarks for R6RS fixnum operations.
    * benchmark-suite/Makefile.am (SCM_BENCHMARKS): Add
      benchmarks/r6rs-arithmetic.

-----------------------------------------------------------------------

Summary of changes:
 benchmark-suite/Makefile.am                        |    1 +
 .../benchmarks/r6rs-arithmetic.bm                  |   28 +++++--
 module/rnrs/arithmetic/fixnums.scm                 |   86 +++++++++----------
 3 files changed, 62 insertions(+), 53 deletions(-)
 copy module/language/elisp/runtime/value-slot.scm => 
benchmark-suite/benchmarks/r6rs-arithmetic.bm (51%)

diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am
index bac1df3..f29743f 100644
--- a/benchmark-suite/Makefile.am
+++ b/benchmark-suite/Makefile.am
@@ -6,6 +6,7 @@ SCM_BENCHMARKS = benchmarks/0-reference.bm              \
                  benchmarks/if.bm                      \
                  benchmarks/logand.bm                  \
                 benchmarks/ports.bm                    \
+                benchmarks/r6rs-arithmetic.bm          \
                 benchmarks/read.bm                     \
                 benchmarks/srfi-1.bm                   \
                 benchmarks/srfi-13.bm                  \
diff --git a/module/language/elisp/runtime/value-slot.scm 
b/benchmark-suite/benchmarks/r6rs-arithmetic.bm
similarity index 51%
copy from module/language/elisp/runtime/value-slot.scm
copy to benchmark-suite/benchmarks/r6rs-arithmetic.bm
index c6cc3b4..4c9b8e6 100644
--- a/module/language/elisp/runtime/value-slot.scm
+++ b/benchmark-suite/benchmarks/r6rs-arithmetic.bm
@@ -1,6 +1,7 @@
-;;; Guile Emacs Lisp
-
-;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
+;;; -*- mode: scheme; coding: utf-8; -*-
+;;; R6RS-specific arithmetic benchmarks
+;;;
+;;; Copyright (C) 2011 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -13,11 +14,22 @@
 ;;; Lesser General Public License for more details.
 ;;;
 ;;; You should have received a copy of the GNU Lesser General Public
-;;; License along with this library; if not, write to the Free Software
-;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 
USA
+;;; License along with this library. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (benchmarks r6rs-arithmetic)
+  #:use-module (benchmark-suite lib)
+  #:use-module (rnrs arithmetic fixnums))
+
+
+(with-benchmark-prefix "fixnum"
 
-;;; Code:
+  (benchmark "fixnum? [yes]" 1e7
+    (fixnum? 10000))
 
-(define-module (language elisp runtime value-slot))
+  (let ((n (+ most-positive-fixnum 100)))
+    (benchmark "fixnum? [no]" 1e7
+      (fixnum? n)))
 
-;;; This module contains the value-slots of elisp symbols.
+  (benchmark "fxxor [2]" 1e7
+    (fxxor 3 8)))
diff --git a/module/rnrs/arithmetic/fixnums.scm 
b/module/rnrs/arithmetic/fixnums.scm
index befbe9d..03511ed 100644
--- a/module/rnrs/arithmetic/fixnums.scm
+++ b/module/rnrs/arithmetic/fixnums.scm
@@ -87,6 +87,7 @@
                        most-negative-fixnum)
          (ice-9 optargs)
          (rnrs base (6))
+         (rnrs control (6))
          (rnrs arithmetic bitwise (6))
          (rnrs conditions (6))
          (rnrs exceptions (6))
@@ -105,50 +106,45 @@
         (>= obj most-negative-fixnum) 
         (<= obj most-positive-fixnum)))
 
-  (define (assert-fixnum . args)
+  (define-syntax assert-fixnum
+    (syntax-rules ()
+      ((_ arg ...)
+       (or (and (fixnum? arg) ...)
+          (raise (make-assertion-violation))))))
+
+  (define (assert-fixnums args)
     (or (for-all fixnum? args) (raise (make-assertion-violation))))
 
-  (define (fx=? fx1 fx2 . rst)
-    (let ((args (cons* fx1 fx2 rst)))
-      (apply assert-fixnum args) 
-      (apply = args)))
-
-  (define (fx>? fx1 fx2 . rst)
-    (let ((args (cons* fx1 fx2 rst))) 
-      (apply assert-fixnum args) 
-      (apply > args)))
-
-  (define (fx<? fx1 fx2 . rst)
-    (let ((args (cons* fx1 fx2 rst)))
-      (apply assert-fixnum rst)
-      (apply < args)))
-
-  (define (fx>=? fx1 fx2 . rst)
-    (let ((args (cons* fx1 fx2 rst)))
-      (apply assert-fixnum rst)
-      (apply >= args)))
-
-  (define (fx<=? fx1 fx2 . rst)
-    (let ((args (cons* fx1 fx2 rst)))
-      (apply assert-fixnum rst)
-      (apply <= args)))
-  
-  (define (fxzero? fx) (assert-fixnum fx) (zero? fx))
-  (define (fxpositive? fx) (assert-fixnum fx) (positive? fx))
-  (define (fxnegative? fx) (assert-fixnum fx) (negative? fx))
-  (define (fxodd? fx) (assert-fixnum fx) (odd? fx))
-  (define (fxeven? fx) (assert-fixnum fx) (even? fx))
-
-  (define (fxmax fx1 fx2 . rst)
-    (let ((args (cons* fx1 fx2 rst)))
-      (apply assert-fixnum args)
-      (apply max args)))
-
-  (define (fxmin fx1 fx2 . rst)
-    (let ((args (cons* fx1 fx2 rst)))
-      (apply assert-fixnum args)
-      (apply min args)))
- 
+  (define-syntax define-fxop*
+    (syntax-rules ()
+      ((_ name op)
+       (define name
+       (case-lambda
+         ((x y)
+          (assert-fixnum x y)
+          (op x y))
+         (args
+          (assert-fixnums args)
+           (apply op args)))))))
+
+  ;; All these predicates don't check their arguments for fixnum-ness,
+  ;; as this doesn't seem to be strictly required by R6RS.
+
+  (define fx=? =)
+  (define fx>? >)
+  (define fx<? <)
+  (define fx>=? >=)
+  (define fx<=? <=)
+
+  (define fxzero? zero?)
+  (define fxpositive? positive?)
+  (define fxnegative? negative?)
+  (define fxodd? odd?)
+  (define fxeven? even?)
+
+  (define-fxop* fxmax max)
+  (define-fxop* fxmin min)
+
   (define (fx+ fx1 fx2)
     (assert-fixnum fx1 fx2) 
     (let ((r (+ fx1 fx2))) 
@@ -219,9 +215,9 @@
       (values s0 s1)))
 
   (define (fxnot fx) (assert-fixnum fx) (lognot fx))
-  (define (fxand . args) (apply assert-fixnum args) (apply logand args))
-  (define (fxior . args) (apply assert-fixnum args) (apply logior args))
-  (define (fxxor . args) (apply assert-fixnum args) (apply logxor args))
+  (define-fxop* fxand logand)
+  (define-fxop* fxior logior)
+  (define-fxop* fxxor logxor)
 
   (define (fxif fx1 fx2 fx3) 
     (assert-fixnum fx1 fx2 fx3) 


hooks/post-receive
-- 
GNU Guile