summaryrefslogtreecommitdiff
path: root/module/rnrs
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2011-01-30 08:48:28 -0500
committerAndy Wingo <wingo@pobox.com>2011-01-30 23:00:38 +0100
commitff62c16828d41955455805dd1b427966944b7d27 (patch)
tree2e4b9bc32fe3ee012180139077fc6308e1380e69 /module/rnrs
parenta16982ca4fafe7d68907c5bf2aae4eb627a1a448 (diff)
downloadguile-ff62c16828d41955455805dd1b427966944b7d27.tar.gz
Add two new sets of fast quotient and remainder operators
* libguile/numbers.c (scm_euclidean_quo_and_rem, scm_euclidean_quotient, scm_euclidean_remainder, scm_centered_quo_and_rem, scm_centered_quotient, scm_centered_remainder): New extensible procedures `euclidean/', `euclidean-quotient', `euclidean-remainder', `centered/', `centered-quotient', `centered-remainder'. * libguile/numbers.h: Add function prototypes. * module/rnrs/base.scm: Remove incorrect stub implementations of `div', `mod', `div-and-mod', `div0', `mod0', and `div0-and-mod0'. Instead do renaming imports of `euclidean-quotient', `euclidean-remainder', `euclidean/', `centered-quotient', `centered-remainder', and `centered/', which are equivalent to the R6RS operators. * module/rnrs/arithmetic/fixnums.scm (fxdiv, fxmod, fxdiv-and-mod, fxdiv0, fxmod0, fxdiv0-and-mod0): Remove redundant checks for division by zero and unnecessary complexity. (fx+/carry): Remove unneeded calls to `inexact->exact'. * module/rnrs/arithmetic/flonums.scm (fldiv, flmod, fldiv-and-mod, fldiv0, flmod0, fldiv0-and-mod0): Remove redundant checks for division by zero and unnecessary complexity. Remove unneeded calls to `inexact->exact' and `exact->inexact' * test-suite/tests/numbers.test: (test-eqv?): New internal predicate for comparing numerical outputs with expected values. Add extensive test code for `euclidean/', `euclidean-quotient', `euclidean-remainder', `centered/', `centered-quotient', `centered-remainder'. * test-suite/tests/r6rs-arithmetic-fixnums.test: Fix some broken test cases, and remove `unresolved' test markers for `fxdiv', `fxmod', `fxdiv-and-mod', `fxdiv0', `fxmod0', and `fxdiv0-and-mod0'. * test-suite/tests/r6rs-arithmetic-flonums.test: Remove `unresolved' test markers for `fldiv', `flmod', `fldiv-and-mod', `fldiv0', `flmod0', and `fldiv0-and-mod0'. * doc/ref/api-data.texi (Arithmetic): Document `euclidean/', `euclidean-quotient', `euclidean-remainder', `centered/', `centered-quotient', and `centered-remainder'. (Operations on Integer Values): Add cross-references to `euclidean/' et al, from `quotient', `remainder', and `modulo'. * doc/ref/r6rs.texi (rnrs base): Improve documentation for `div', `mod', `div-and-mod', `div0', `mod0', and `div0-and-mod0'. Add cross-references to `euclidean/' et al. * NEWS: Add NEWS entry.
Diffstat (limited to 'module/rnrs')
-rw-r--r--module/rnrs/arithmetic/fixnums.scm23
-rw-r--r--module/rnrs/arithmetic/flonums.scm31
-rw-r--r--module/rnrs/base.scm23
3 files changed, 23 insertions, 54 deletions
diff --git a/module/rnrs/arithmetic/fixnums.scm b/module/rnrs/arithmetic/fixnums.scm
index c1f3571ea..befbe9d35 100644
--- a/module/rnrs/arithmetic/fixnums.scm
+++ b/module/rnrs/arithmetic/fixnums.scm
@@ -1,6 +1,6 @@
;;; fixnums.scm --- The R6RS fixnums arithmetic library
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 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
@@ -175,40 +175,33 @@
(define (fxdiv fx1 fx2)
(assert-fixnum fx1 fx2)
- (if (zero? fx2) (raise (make-assertion-violation)))
- (let ((r (div fx1 fx2))) r))
+ (div fx1 fx2))
(define (fxmod fx1 fx2)
(assert-fixnum fx1 fx2)
- (if (zero? fx2) (raise (make-assertion-violation)))
- (let ((r (mod fx1 fx2))) r))
+ (mod fx1 fx2))
(define (fxdiv-and-mod fx1 fx2)
(assert-fixnum fx1 fx2)
- (if (zero? fx2) (raise (make-assertion-violation)))
(div-and-mod fx1 fx2))
(define (fxdiv0 fx1 fx2)
(assert-fixnum fx1 fx2)
- (if (zero? fx2) (raise (make-assertion-violation)))
- (let ((r (div0 fx1 fx2))) r))
+ (div0 fx1 fx2))
(define (fxmod0 fx1 fx2)
(assert-fixnum fx1 fx2)
- (if (zero? fx2) (raise (make-assertion-violation)))
- (let ((r (mod0 fx1 fx2))) r))
+ (mod0 fx1 fx2))
(define (fxdiv0-and-mod0 fx1 fx2)
(assert-fixnum fx1 fx2)
- (if (zero? fx2) (raise (make-assertion-violation)))
- (call-with-values (lambda () (div0-and-mod0 fx1 fx2))
- (lambda (q r) (values q r))))
+ (div0-and-mod0 fx1 fx2))
(define (fx+/carry fx1 fx2 fx3)
(assert-fixnum fx1 fx2 fx3)
(let* ((s (+ fx1 fx2 fx3))
- (s0 (mod0 s (inexact->exact (expt 2 (fixnum-width)))))
- (s1 (div0 s (inexact->exact (expt 2 (fixnum-width))))))
+ (s0 (mod0 s (expt 2 (fixnum-width))))
+ (s1 (div0 s (expt 2 (fixnum-width)))))
(values s0 s1)))
(define (fx-/carry fx1 fx2 fx3)
diff --git a/module/rnrs/arithmetic/flonums.scm b/module/rnrs/arithmetic/flonums.scm
index 4fadbd00a..b65c294b5 100644
--- a/module/rnrs/arithmetic/flonums.scm
+++ b/module/rnrs/arithmetic/flonums.scm
@@ -1,6 +1,6 @@
;;; flonums.scm --- The R6RS flonums arithmetic library
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 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
@@ -127,40 +127,27 @@
(define (fldiv-and-mod fl1 fl2)
(assert-iflonum fl1 fl2)
- (if (zero? fl2) (raise (make-assertion-violation)))
- (let ((fx1 (inexact->exact fl1))
- (fx2 (inexact->exact fl2)))
- (call-with-values (lambda () (div-and-mod fx1 fx2))
- (lambda (div mod) (values (exact->inexact div)
- (exact->inexact mod))))))
+ (div-and-mod fl1 fl2))
(define (fldiv fl1 fl2)
(assert-iflonum fl1 fl2)
- (if (zero? fl2) (raise (make-assertion-violation)))
- (let ((fx1 (inexact->exact fl1))
- (fx2 (inexact->exact fl2)))
- (exact->inexact (quotient fx1 fx2))))
+ (div fl1 fl2))
(define (flmod fl1 fl2)
(assert-iflonum fl1 fl2)
- (if (zero? fl2) (raise (make-assertion-violation)))
- (let ((fx1 (inexact->exact fl1))
- (fx2 (inexact->exact fl2)))
- (exact->inexact (modulo fx1 fx2))))
+ (mod fl1 fl2))
(define (fldiv0-and-mod0 fl1 fl2)
(assert-iflonum fl1 fl2)
- (if (zero? fl2) (raise (make-assertion-violation)))
- (let* ((fx1 (inexact->exact fl1))
- (fx2 (inexact->exact fl2)))
- (call-with-values (lambda () (div0-and-mod0 fx1 fx2))
- (lambda (q r) (values (real->flonum q) (real->flonum r))))))
+ (div0-and-mod0 fl1 fl2))
(define (fldiv0 fl1 fl2)
- (call-with-values (lambda () (fldiv0-and-mod0 fl1 fl2)) (lambda (q r) q)))
+ (assert-iflonum fl1 fl2)
+ (div0 fl1 fl2))
(define (flmod0 fl1 fl2)
- (call-with-values (lambda () (fldiv0-and-mod0 fl1 fl2)) (lambda (q r) r)))
+ (assert-iflonum fl1 fl2)
+ (mod0 fl1 fl2))
(define (flnumerator fl)
(assert-flonum fl)
diff --git a/module/rnrs/base.scm b/module/rnrs/base.scm
index 04a7e23a8..c81ded134 100644
--- a/module/rnrs/base.scm
+++ b/module/rnrs/base.scm
@@ -74,8 +74,12 @@
syntax-rules identifier-syntax)
(import (rename (except (guile) error raise)
- (quotient div)
- (modulo mod)
+ (euclidean-quotient div)
+ (euclidean-remainder mod)
+ (euclidean/ div-and-mod)
+ (centered-quotient div0)
+ (centered-remainder mod0)
+ (centered/ div0-and-mod0)
(inf? infinite?)
(exact->inexact inexact)
(inexact->exact exact))
@@ -119,21 +123,6 @@
(define (vector-map proc . vecs)
(list->vector (apply map (cons proc (map vector->list vecs)))))
- (define (div-and-mod x y) (let ((q (div x y)) (r (mod x y))) (values q r)))
-
- (define (div0 x y)
- (call-with-values (lambda () (div0-and-mod0 x y)) (lambda (q r) q)))
-
- (define (mod0 x y)
- (call-with-values (lambda () (div0-and-mod0 x y)) (lambda (q r) r)))
-
- (define (div0-and-mod0 x y)
- (call-with-values (lambda () (div-and-mod x y))
- (lambda (q r)
- (cond ((< r (abs (/ y 2))) (values q r))
- ((negative? y) (values (- q 1) (+ r y)))
- (else (values (+ q 1) (+ r y)))))))
-
(define raise
(@ (rnrs exceptions) raise))
(define condition