mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-21 19:20:21 +02:00
Code Activity

Add four new sets of fast quotient and remainder operators

Browse source 
* libguile/numbers.c (scm_floor_divide, scm_floor_quotient,
  scm_floor_remainder, scm_ceiling_divide, scm_ceiling_quotient,
  scm_ceiling_remainder, scm_truncate_divide, scm_truncate_quotient,
  scm_truncate_remainder, scm_round_divide, scm_round_quotient,
  scm_round_remainder): New extensible procedures `floor/',
  `floor-quotient', `floor-remainder', `ceiling/', `ceiling-quotient',
  `ceiling-remainder', `truncate/', `truncate-quotient',
  `truncate-remainder', `round/', `round-quotient', and
  `round-remainder'.

* libguile/numbers.h: Add function prototypes.

* test-suite/tests/numbers.test: Add tests.

* doc/ref/api-data.texi (Arithmetic): Add documentation.

* NEWS: Add NEWS entry.
This commit is contained in:
Mark H Weaver 2011-02-13 09:16:27 -05:00 • committed by Andy Wingo
parent 03ddd15bae
commit 8f9da3406b
5 changed files with 2451 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -4148,6 +4148,42 @@
(test-within-range? 0 <= r < (abs y)))
(test-eqv? q (/ x y)))))
(define (valid-floor-answer? x y q r)
(and (eq? (exact? q)
(exact? r)
(and (exact? x) (exact? y)))
(test-eqv? r (- x (* q y)))
(if (and (finite? x) (finite? y))
(and (integer? q)
(if (> y 0)
(test-within-range? 0 <= r < y)
(test-within-range? y < r <= 0)))
(test-eqv? q (/ x y)))))
(define (valid-ceiling-answer? x y q r)
(and (eq? (exact? q)
(exact? r)
(and (exact? x) (exact? y)))
(test-eqv? r (- x (* q y)))
(if (and (finite? x) (finite? y))
(and (integer? q)
(if (> y 0)
(test-within-range? (- y) < r <= 0)
(test-within-range? 0 <= r < (- y))))
(test-eqv? q (/ x y)))))
(define (valid-truncate-answer? x y q r)
(and (eq? (exact? q)
(exact? r)
(and (exact? x) (exact? y)))
(test-eqv? r (- x (* q y)))
(if (and (finite? x) (finite? y))
(and (integer? q)
(if (> x 0)
(test-within-range? 0 <= r < (abs y))
(test-within-range? (- (abs y)) < r <= 0)))
(test-eqv? q (/ x y)))))
(define (valid-centered-answer? x y q r)
(and (eq? (exact? q)
(exact? r)
@ -4159,6 +4195,19 @@
(* -1/2 (abs y)) <= r < (* +1/2 (abs y))))
(test-eqv? q (/ x y)))))
(define (valid-round-answer? x y q r)
(and (eq? (exact? q)
(exact? r)
(and (exact? x) (exact? y)))
(test-eqv? r (- x (* q y)))
(if (and (finite? x) (finite? y))
(and (integer? q)
(let ((ay/2 (/ (abs y) 2)))
(if (even? q)
(test-within-range? (- ay/2) <= r <= ay/2)
(test-within-range? (- ay/2) < r < ay/2))))
(test-eqv? q (/ x y)))))
(define (for lsts f) (apply for-each f lsts))
(define big (expt 10 (1+ (inexact->exact (ceiling (log10 fixnum-max))))))
@ -4284,8 +4333,32 @@
euclidean-remainder
valid-euclidean-answer?))
(with-test-prefix "floor/"
(run-division-tests floor/
floor-quotient
floor-remainder
valid-floor-answer?))
(with-test-prefix "ceiling/"
(run-division-tests ceiling/
ceiling-quotient
ceiling-remainder
valid-ceiling-answer?))
(with-test-prefix "truncate/"
(run-division-tests truncate/
truncate-quotient
truncate-remainder
valid-truncate-answer?))
(with-test-prefix "centered/"
(run-division-tests centered/
centered-quotient
centered-remainder
valid-centered-answer?)))
valid-centered-answer?))
(with-test-prefix "round/"
(run-division-tests round/
round-quotient
round-remainder
valid-round-answer?)))