dmbcs/guile
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add two new sets of fast quotient and remainder operators

Browse source 
* 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.
This commit is contained in:
Mark H Weaver 2011-01-30 08:48:28 -05:00 • committed by Andy Wingo
commit ff62c16828
11 changed files with 1603 additions and 90 deletions
Download patch file Download diff file Expand all files Collapse all files

29
NEWS
View file

@ -12,6 +12,29 @@ Changes in 1.9.15 (since the 1.9.14 prerelease):
** Changes and bugfixes in numerics code
*** Added two new sets of fast quotient and remainder operators
Added two new sets of fast quotient and remainder operator pairs with
different semantics than the R5RS operators. They support not only
integers, but all reals, including exact rationals and inexact
floating point numbers.
These procedures accept two real numbers N and D, where the divisor D
must be non-zero. `euclidean-quotient' returns the integer Q and
`euclidean-remainder' returns the real R such that N = Q*D + R and
0 <= R < |D|. `euclidean/' returns both Q and R, and is more
efficient than computing each separately. Note that when D > 0,
`euclidean-quotient' returns floor(N/D), and when D < 0 it returns
ceiling(N/D).
`centered-quotient', `centered-remainder', and `centered/' are similar
except that the range of remainders is -abs(D/2) <= R < abs(D/2), and
`centered-quotient' rounds N/D to the nearest integer.
Note that these operators are equivalent to the R6RS integer division
operators `div', `mod', `div-and-mod', `div0', `mod0', and
`div0-and-mod0'.
*** `eqv?' and `equal?' now compare numbers equivalently
scm_equal_p `equal?' now behaves equivalently to scm_eqv_p `eqv?' for
@ -64,6 +87,12 @@ NaNs are neither finite nor infinite.
*** R6RS base library changes
**** `div', `mod', `div-and-mod', `div0', `mod0', `div0-and-mod0'
Efficient versions of these R6RS division operators are now supported.
See the NEWS entry entitled `Added two new sets of fast quotient and
remainder operators' for more information.
**** `infinite?' changes
`infinite?' now returns #t for non-real complex infinities, and throws

79
doc/ref/api-data.texi
View file

@ -897,6 +897,9 @@ sign as @var{n}. In all cases quotient and remainder satisfy
(remainder 13 4) @result{} 1
(remainder -13 4) @result{} -1
@end lisp
See also @code{euclidean-quotient}, @code{euclidean-remainder} and
related operations in @ref{Arithmetic}.
@end deffn
@c begin (texi-doc-string "guile" "modulo")
@ -911,6 +914,9 @@ sign as @var{d}.
(modulo 13 -4) @result{} -3
(modulo -13 -4) @result{} -1
@end lisp
See also @code{euclidean-quotient}, @code{euclidean-remainder} and
related operations in @ref{Arithmetic}.
@end deffn
@c begin (texi-doc-string "guile" "gcd")
@ -1130,6 +1136,12 @@ Returns the magnitude or angle of @var{z} as a @code{double}.
@rnindex ceiling
@rnindex truncate
@rnindex round
@rnindex euclidean/
@rnindex euclidean-quotient
@rnindex euclidean-remainder
@rnindex centered/
@rnindex centered-quotient
@rnindex centered-remainder
The C arithmetic functions below always takes two arguments, while the
Scheme functions can take an arbitrary number. When you need to
@ -1229,6 +1241,73 @@ respectively, but these functions take and return @code{double}
values.
@end deftypefn
@deffn {Scheme Procedure} euclidean/ x y
@deffnx {Scheme Procedure} euclidean-quotient x y
@deffnx {Scheme Procedure} euclidean-remainder x y
@deffnx {C Function} scm_euclidean_quo_and_rem (x y)
@deffnx {C Function} scm_euclidean_quotient (x y)
@deffnx {C Function} scm_euclidean_remainder (x y)
These procedures accept two real numbers @var{x} and @var{y}, where the
divisor @var{y} must be non-zero. @code{euclidean-quotient} returns the
integer @var{q} and @code{euclidean-remainder} returns the real number
@var{r} such that @math{@var{x} = @var{q}*@var{y} + @var{r}} and
@math{0 <= @var{r} < abs(@var{y})}. @code{euclidean/} returns both @var{q} and
@var{r}, and is more efficient than computing each separately. Note
that when @math{@var{y} > 0}, @code{euclidean-quotient} returns
@math{floor(@var{x}/@var{y})}, otherwise it returns
@math{ceiling(@var{x}/@var{y})}.
Note that these operators are equivalent to the R6RS operators
@code{div}, @code{mod}, and @code{div-and-mod}.
@lisp
(euclidean-quotient 123 10) @result{} 12
(euclidean-remainder 123 10) @result{} 3
(euclidean/ 123 10) @result{} 12 and 3
(euclidean/ 123 -10) @result{} -12 and 3
(euclidean/ -123 10) @result{} -13 and 7
(euclidean/ -123 -10) @result{} 13 and 7
(euclidean/ -123.2 -63.5) @result{} 2.0 and 3.8
(euclidean/ 16/3 -10/7) @result{} -3 and 22/21
@end lisp
@end deffn
@deffn {Scheme Procedure} centered/ x y
@deffnx {Scheme Procedure} centered-quotient x y
@deffnx {Scheme Procedure} centered-remainder x y
@deffnx {C Function} scm_centered_quo_and_rem (x y)
@deffnx {C Function} scm_centered_quotient (x y)
@deffnx {C Function} scm_centered_remainder (x y)
These procedures accept two real numbers @var{x} and @var{y}, where the
divisor @var{y} must be non-zero. @code{centered-quotient} returns the
integer @var{q} and @code{centered-remainder} returns the real number
@var{r} such that @math{@var{x} = @var{q}*@var{y} + @var{r}} and
@math{-abs(@var{y}/2) <= @var{r} < abs(@var{y}/2)}. @code{centered/}
returns both @var{q} and @var{r}, and is more efficient than computing
each separately.
Note that @code{centered-quotient} returns @math{@var{x}/@var{y}}
rounded to the nearest integer. When @math{@var{x}/@var{y}} lies
exactly half-way between two integers, the tie is broken according to
the sign of @var{y}. If @math{@var{y} > 0}, ties are rounded toward
positive infinity, otherwise they are rounded toward negative infinity.
This is a consequence of the requirement that @math{-abs(@var{y}/2) <= @var{r} < abs(@var{y}/2)}.
Note that these operators are equivalent to the R6RS operators
@code{div0}, @code{mod0}, and @code{div0-and-mod0}.
@lisp
(centered-quotient 123 10) @result{} 12
(centered-remainder 123 10) @result{} 3
(centered/ 123 10) @result{} 12 and 3
(centered/ 123 -10) @result{} -12 and 3
(centered/ -123 10) @result{} -12 and -3
(centered/ -123 -10) @result{} 12 and -3
(centered/ -123.2 -63.5) @result{} 2.0 and 3.8
(centered/ 16/3 -10/7) @result{} -4 and -8/21
@end lisp
@end deffn
@node Scientific
@subsubsection Scientific Functions

70
doc/ref/r6rs.texi
View file

@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 2010
@c Copyright (C) 2010, 2011
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@ -464,21 +464,65 @@ grouped below by the existing manual sections to which they correspond.
@xref{Arithmetic}, for documentation.
@end deffn
@deffn {Scheme Procedure} div x1 x2
@deffnx {Scheme Procedure} mod x1 x2
@deffnx {Scheme Procedure} div-and-mod x1 x2
These procedures implement number-theoretic division.
@rnindex div
@rnindex mod
@rnindex div-and-mod
@deffn {Scheme Procedure} div x y
@deffnx {Scheme Procedure} mod x y
@deffnx {Scheme Procedure} div-and-mod x y
These procedures accept two real numbers @var{x} and @var{y}, where the
divisor @var{y} must be non-zero. @code{div} returns the integer @var{q}
and @code{mod} returns the real number @var{r} such that
@math{@var{x} = @var{q}*@var{y} + @var{r}} and @math{0 <= @var{r} < abs(@var{y})}.
@code{div-and-mod} returns both @var{q} and @var{r}, and is more
efficient than computing each separately. Note that when @math{@var{y} > 0},
@code{div} returns @math{floor(@var{x}/@var{y})}, otherwise
it returns @math{ceiling(@var{x}/@var{y})}.
@code{div-and-mod} returns two values, the respective results of
@code{(div x1 x2)} and @code{(mod x1 x2)}.
@lisp
(div 123 10) @result{} 12
(mod 123 10) @result{} 3
(div-and-mod 123 10) @result{} 12 and 3
(div-and-mod 123 -10) @result{} -12 and 3
(div-and-mod -123 10) @result{} -13 and 7
(div-and-mod -123 -10) @result{} 13 and 7
(div-and-mod -123.2 -63.5) @result{} 2.0 and 3.8
(div-and-mod 16/3 -10/7) @result{} -3 and 22/21
@end lisp
@end deffn
@deffn {Scheme Procedure} div0 x1 x2
@deffnx {Scheme Procedure} mod0 x1 x2
@deffnx {Scheme Procedure} div0-and-mod0 x1 x2
These procedures are similar to @code{div}, @code{mod}, and
@code{div-and-mod}, except that @code{mod0} returns values that lie
within a half-open interval centered on zero.
@rnindex div0
@rnindex mod0
@rnindex div0-and-mod0
@deffn {Scheme Procedure} div0 x y
@deffnx {Scheme Procedure} mod0 x y
@deffnx {Scheme Procedure} div0-and-mod0 x y
These procedures accept two real numbers @var{x} and @var{y}, where the
divisor @var{y} must be non-zero. @code{div0} returns the
integer @var{q} and @code{rem0} returns the real number
@var{r} such that @math{@var{x} = @var{q}*@var{y} + @var{r}} and
@math{-abs(@var{y}/2) <= @var{r} < abs(@var{y}/2)}. @code{div0-and-mod0}
returns both @var{q} and @var{r}, and is more efficient than computing
each separately.
Note that @code{div0} returns @math{@var{x}/@var{y}} rounded to the
nearest integer. When @math{@var{x}/@var{y}} lies exactly half-way
between two integers, the tie is broken according to the sign of
@var{y}. If @math{@var{y} > 0}, ties are rounded toward positive
infinity, otherwise they are rounded toward negative infinity.
This is a consequence of the requirement that
@math{-abs(@var{y}/2) <= @var{r} < abs(@var{y}/2)}.
@lisp
(div0 123 10) @result{} 12
(mod0 123 10) @result{} 3
(div0-and-mod0 123 10) @result{} 12 and 3
(div0-and-mod0 123 -10) @result{} -12 and 3
(div0-and-mod0 -123 10) @result{} -12 and -3
(div0-and-mod0 -123 -10) @result{} 12 and -3
(div0-and-mod0 -123.2 -63.5) @result{} 2.0 and 3.8
(div0-and-mod0 16/3 -10/7) @result{} -4 and -8/21
@end lisp
@end deffn
@deffn {Scheme Procedure} exact-integer-sqrt k

1227
libguile/numbers.c
View file

File diff suppressed because it is too large Load diff

6
libguile/numbers.h
View file

@ -177,6 +177,12 @@ SCM_API SCM scm_abs (SCM x);
SCM_API SCM scm_quotient (SCM x, SCM y);
SCM_API SCM scm_remainder (SCM x, SCM y);
SCM_API SCM scm_modulo (SCM x, SCM y);
SCM_API SCM scm_euclidean_quo_and_rem (SCM x, SCM y);
SCM_API SCM scm_euclidean_quotient (SCM x, SCM y);
SCM_API SCM scm_euclidean_remainder (SCM x, SCM y);
SCM_API SCM scm_centered_quo_and_rem (SCM x, SCM y);
SCM_API SCM scm_centered_quotient (SCM x, SCM y);
SCM_API SCM scm_centered_remainder (SCM x, SCM y);
SCM_API SCM scm_gcd (SCM x, SCM y);
SCM_API SCM scm_lcm (SCM n1, SCM n2);
SCM_API SCM scm_logand (SCM n1, SCM n2);

23
module/rnrs/arithmetic/fixnums.scm
View file

@ -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)

31
module/rnrs/arithmetic/flonums.scm
View file

@ -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)

23
module/rnrs/base.scm
View file

@ -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

173
test-suite/tests/numbers.test
View file

@ -17,7 +17,8 @@
(define-module (test-suite test-numbers)
#:use-module (test-suite lib)
#:use-module (ice-9 documentation))
#:use-module (ice-9 documentation)
#:use-module (srfi srfi-11)) ; let-values
;;;
;;; miscellaneous
@ -92,6 +93,35 @@
(negative? obj)
(inf? obj)))
;;
;; Tolerance used by test-eqv? for inexact numbers.
;;
(define test-epsilon 1e-10)
;;
;; Like eqv?, except that inexact finite numbers need only be within
;; test-epsilon (1e-10) to be considered equal. An exception is made
;; for zeroes, however. If X is zero, then it is tested using eqv?
;; without any allowance for imprecision. In particular, 0.0 is
;; considered distinct from -0.0. For non-real complex numbers,
;; each component is tested according to these rules. The intent
;; is that the known-correct value will be the first parameter.
;;
(define (test-eqv? x y)
(cond ((real? x)
(and (real? y) (test-real-eqv? x y)))
((complex? x)
(and (not (real? y))
(test-real-eqv? (real-part x) (real-part y))
(test-real-eqv? (imag-part x) (imag-part y))))
(else (eqv? x y))))
;; Auxiliary predicate used by test-eqv?
(define (test-real-eqv? x y)
(cond ((or (exact? x) (zero? x) (nan? x) (inf? x))
(eqv? x y))
(else (and (inexact? y) (> test-epsilon (abs (- x y)))))))
(define const-e 2.7182818284590452354)
(define const-e^2 7.3890560989306502274)
(define const-1/e 0.3678794411714423215)
@ -3480,3 +3510,144 @@
(pass-if "-100i swings back to 45deg down"
(eqv-loosely? +7.071-7.071i (sqrt -100.0i))))
;;;
;;; euclidean/
;;; euclidean-quotient
;;; euclidean-remainder
;;; centered/
;;; centered-quotient
;;; centered-remainder
;;;
(with-test-prefix "Number-theoretic division"
;; Tests that (lo <= x < hi),
;; but allowing for imprecision
;; if x is inexact.
(define (test-within-range? lo hi x)
(if (exact? x)
(and (<= lo x) (< x hi))
(let ((lo (- lo test-epsilon))
(hi (+ hi test-epsilon)))
(<= lo x hi))))
(define (safe-euclidean-quotient x y)
(cond ((not (and (real? x) (real? y))) (throw 'wrong-type-arg))
((zero? y) (throw 'divide-by-zero))
((nan? y) (nan))
((positive? y) (floor (/ x y)))
((negative? y) (ceiling (/ x y)))
(else (throw 'unknown-problem))))
(define (safe-euclidean-remainder x y)
(- x (* y (safe-euclidean-quotient x y))))
(define (safe-euclidean/ x y)
(let ((q (safe-euclidean-quotient x y))
(r (safe-euclidean-remainder x y)))
(if (not (and (eq? (exact? q) (exact? r))
(eq? (exact? q) (and (exact? x) (exact? y)))
(test-real-eqv? r (- x (* q y)))
(or (and (integer? q)
(test-within-range? 0 (abs y) r))
(not (finite? x))
(not (finite? y)))))
(throw 'safe-euclidean/-is-broken (list x y q r))
(values q r))))
(define (safe-centered-quotient x y)
(cond ((not (and (real? x) (real? y))) (throw 'wrong-type-arg))
((zero? y) (throw 'divide-by-zero))
((nan? y) (nan))
((positive? y) (floor (+ 1/2 (/ x y))))
((negative? y) (ceiling (+ -1/2 (/ x y))))
(else (throw 'unknown-problem))))
(define (safe-centered-remainder x y)
(- x (* y (safe-centered-quotient x y))))
(define (safe-centered/ x y)
(let ((q (safe-centered-quotient x y))
(r (safe-centered-remainder x y)))
(if (not (and (eq? (exact? q) (exact? r))
(eq? (exact? q) (and (exact? x) (exact? y)))
(test-real-eqv? r (- x (* q y)))
(or (and (integer? q)
(test-within-range? (* -1/2 (abs y))
(* +1/2 (abs y))
r))
(not (finite? x))
(not (finite? y)))))
(throw 'safe-centered/-is-broken (list x y q r))
(values q r))))
(define test-numerators
(append
(list 123 125 127 130 3 5 10 123.2 125.0
-123 -125 -127 -130 -3 -5 -10 -123.2 -125.0
127.2 130.0 123/7 125/7 127/7 130/7
-127.2 -130.0 -123/7 -125/7 -127/7 -130/7
0 +0.0 -0.0 +inf.0 -inf.0 +nan.0
most-negative-fixnum (1+ most-positive-fixnum)
(1- most-negative-fixnum))
(apply append
(map (lambda (x) (list (* x (+ 1 most-positive-fixnum))
(* x (+ 2 most-positive-fixnum))))
'( 123 125 127 130 3 5 10
-123 -125 -127 -130 -3 -5 -10)))))
(define test-denominators
(list 10 5 10/7 127/2 10.0 63.5
-10 -5 -10/7 -127/2 -10.0 -63.5
+inf.0 -inf.0 +nan.0 most-negative-fixnum
(+ 1 most-positive-fixnum) (+ -1 most-negative-fixnum)
(+ 2 most-positive-fixnum) (+ -2 most-negative-fixnum)))
(define (do-tests-1 op-name real-op safe-op)
(for-each (lambda (d)
(for-each (lambda (n)
(run-test (list op-name n d) #t
(lambda ()
(test-eqv? (real-op n d)
(safe-op n d)))))
test-numerators))
test-denominators))
(define (do-tests-2 op-name real-op safe-op)
(for-each (lambda (d)
(for-each (lambda (n)
(run-test (list op-name n d) #t
(lambda ()
(let-values
(((q r) (safe-op n d))
((q1 r1) (real-op n d)))
(and (test-eqv? q q1)
(test-eqv? r r1))))))
test-numerators))
test-denominators))
(with-test-prefix "euclidean-quotient"
(do-tests-1 'euclidean-quotient
euclidean-quotient
safe-euclidean-quotient))
(with-test-prefix "euclidean-remainder"
(do-tests-1 'euclidean-remainder
euclidean-remainder
safe-euclidean-remainder))
(with-test-prefix "euclidean/"
(do-tests-2 'euclidean/
euclidean/
safe-euclidean/))
(with-test-prefix "centered-quotient"
(do-tests-1 'centered-quotient
centered-quotient
safe-centered-quotient))
(with-test-prefix "centered-remainder"
(do-tests-1 'centered-remainder
centered-remainder
safe-centered-remainder))
(with-test-prefix "centered/"
(do-tests-2 'centered/
centered/
safe-centered/)))

23
test-suite/tests/r6rs-arithmetic-fixnums.test
View file

@ -1,6 +1,6 @@
;;; arithmetic-fixnums.test --- Test suite for R6RS (rnrs arithmetic bitwise)
;; 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
@ -121,32 +121,25 @@
(pass-if "simple"
(call-with-values (lambda () (fxdiv-and-mod 123 10))
(lambda (d m)
(or (and (fx=? d 12) (fx=? m 3))
(throw 'unresolved))))))
(and (fx=? d 12) (fx=? m 3))))))
(with-test-prefix "fxdiv"
(pass-if "simple" (or (fx=? (fxdiv -123 10) -13) (throw 'unresolved))))
(with-test-prefix "fxmod"
(pass-if "simple" (or (fx=? (fxmod -123 10) 7) (throw 'unresolved))))
(with-test-prefix "fxdiv" (pass-if "simple" (fx=? (fxdiv -123 10) -13)))
(with-test-prefix "fxmod" (pass-if "simple" (fx=? (fxmod -123 10) 7)))
(with-test-prefix "fxdiv0-and-mod0"
(pass-if "simple"
(call-with-values (lambda () (fxdiv0-and-mod0 -123 10))
(lambda (d m)
(or (and (fx=? d 12) (fx=? m -3))
(throw 'unresolved))))))
(and (fx=? d -12) (fx=? m -3))))))
(with-test-prefix "fxdiv0"
(pass-if "simple" (or (fx=? (fxdiv0 -123 10) 12) (throw 'unresolved))))
(with-test-prefix "fxmod0"
(pass-if "simple" (or (fx=? (fxmod0 -123 10) -3) (throw 'unresolved))))
(with-test-prefix "fxdiv0" (pass-if "simple" (fx=? (fxdiv0 -123 10) -12)))
(with-test-prefix "fxmod0" (pass-if "simple" (fx=? (fxmod0 -123 10) -3)))
;; Without working div and mod implementations and without any example results
;; from the spec, I have no idea what the results of these functions should
;; be. -juliang
;; UPDATE: div and mod implementations are now working properly -mhw
(with-test-prefix "fx+/carry" (pass-if "simple" (throw 'unresolved)))

9
test-suite/tests/r6rs-arithmetic-flonums.test
View file

@ -1,6 +1,6 @@
;;; arithmetic-flonums.test --- Test suite for R6RS (rnrs arithmetic flonums)
;; 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
@ -195,14 +195,13 @@
(pass-if "simple"
(call-with-values (lambda () (fldiv0-and-mod0 -123.0 10.0))
(lambda (div mod)
(or (and (fl=? div -12.0) (fl=? mod -3.0))
(throw 'unresolved))))))
(and (fl=? div -12.0) (fl=? mod -3.0))))))
(with-test-prefix "fldiv0"
(pass-if "simple" (or (fl=? (fldiv0 -123.0 10.0) -12.0) (throw 'unresolved))))
(pass-if "simple" (fl=? (fldiv0 -123.0 10.0) -12.0)))
(with-test-prefix "flmod0"
(pass-if "simple" (or (fl=? (flmod0 -123.0 10.0) -3.0) (throw 'unresolved))))
(pass-if "simple" (fl=? (flmod0 -123.0 10.0) -3.0)))
(with-test-prefix "flnumerator"
(pass-if "simple" (fl=? (flnumerator 0.5) 1.0))