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

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)