diff options
author | Mark H Weaver <mhw@netris.org> | 2011-01-30 08:48:28 -0500 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-01-30 23:00:38 +0100 |
commit | ff62c16828d41955455805dd1b427966944b7d27 (patch) | |
tree | 2e4b9bc32fe3ee012180139077fc6308e1380e69 /module/rnrs | |
parent | a16982ca4fafe7d68907c5bf2aae4eb627a1a448 (diff) | |
download | guile-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.scm | 23 | ||||
-rw-r--r-- | module/rnrs/arithmetic/flonums.scm | 31 | ||||
-rw-r--r-- | module/rnrs/base.scm | 23 |
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 |