From 17b205d79e34573ce3892842e137aa1da8f4da57 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 28 Apr 1997 05:59:49 +0000 Subject: [PATCH] Change method used by EXACT->INEXACT on integers. It turns out that the old method, the INT:->FLONUM, does not round reliably, and as a consequence the LSB of the result is sometimes wrong. However, the conversion performed by INTEGER->FLONUM is accurate provided that the integer being converted can be exactly represented by a flonum, i.e. for IEEE double-precision floats, an integer with magnitude less than (EXPT 2 53). The algorithm used to convert ratnums to flonums already has this property, so the integer conversion has been changed to use it. --- v7/src/runtime/arith.scm | 128 +++++++++++++++++++-------------------- 1 file changed, 64 insertions(+), 64 deletions(-) diff --git a/v7/src/runtime/arith.scm b/v7/src/runtime/arith.scm index 5d2b0d9f9..46e86295c 100644 --- a/v7/src/runtime/arith.scm +++ b/v7/src/runtime/arith.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: arith.scm,v 1.35 1997/04/23 07:26:06 cph Exp $ +$Id: arith.scm,v 1.36 1997/04/28 05:59:49 cph Exp $ Copyright (c) 1989-97 Massachusetts Institute of Technology @@ -802,47 +802,47 @@ MIT in each case. |# n (make-ratnum n d))) -(define (rat:->flonum q) +(define (rat:->inexact q) (if (ratnum? q) - (ratnum->flonum q) - (int:->flonum q))) - -(define (ratnum->flonum q) - (let ((q>0 - (lambda (n d) - (let ((k - (int:- (integer-length-in-bits n) - (integer-length-in-bits d))) - (p flo:significand-digits-base-2)) - (letrec - ((step1 - (lambda (n d) - ;; (assert (< (expt 2 (- k 1)) (/ n d) (expt 2 (+ k 1)))) - (if (int:< k 0) - (step2 (integer-shift-left n (int:- 0 k)) d) - (step2 n (integer-shift-left d k))))) - (step2 - (lambda (n d) - ;; (assert (< 1/2 (/ n d) 2)) - (if (int:< n d) - (step3 n d (int:- k p)) - (step3 n (int:* 2 d) (int:- (int:+ k 1) p))))) - (step3 - (lambda (n d e) - ;; (assert (and (<= 1/2 (/ n d)) (< (/ n d) 1))) - (let ((n (int:round (integer-shift-left n p) d))) - (if (int:= n int:flonum-integer-limit) - (step4 (int:quotient n 2) (int:1+ e)) - (step4 n e))))) - (step4 - (lambda (n e) - (flo:denormalize (integer->flonum n #b11) e)))) - (step1 n d)))))) - (let ((n (ratnum-numerator q)) - (d (ratnum-denominator q))) - (cond ((int:positive? n) (q>0 n d)) - ((int:negative? n) (flo:negate (q>0 (int:negate n) d))) - (else flo:0))))) + (let ((n (ratnum-numerator q)) + (d (ratnum-denominator q))) + (cond ((int:positive? n) (ratio->flonum n d)) + ((int:negative? n) (flo:negate (ratio->flonum (int:negate n) d))) + (else flo:0))) + (int:->inexact q))) + +(define (int:->inexact n) + (cond ((int:positive? n) (ratio->flonum n 1)) + ((int:negative? n) (flo:negate (ratio->flonum (int:negate n) 1))) + (else flo:0))) + +(define (ratio->flonum n d) + (let ((k (int:- (integer-length-in-bits n) (integer-length-in-bits d))) + (p flo:significand-digits-base-2)) + (letrec + ((step1 + (lambda (n d) + ;; (assert (< (expt 2 (- k 1)) (/ n d) (expt 2 (+ k 1)))) + (if (int:< k 0) + (step2 (integer-shift-left n (int:- 0 k)) d) + (step2 n (integer-shift-left d k))))) + (step2 + (lambda (n d) + ;; (assert (< 1/2 (/ n d) 2)) + (if (int:< n d) + (step3 n d (int:- k p)) + (step3 n (int:* 2 d) (int:- (int:+ k 1) p))))) + (step3 + (lambda (n d e) + ;; (assert (and (<= 1/2 (/ n d)) (< (/ n d) 1))) + (let ((n (int:round (integer-shift-left n p) d))) + (if (int:= n int:flonum-integer-limit) + (step4 (int:quotient n 2) (int:1+ e)) + (step4 n e))))) + (step4 + (lambda (n e) + (flo:denormalize (integer->flonum n #b11) e)))) + (step1 n d)))) (define (flo:significand-digits radix) (cond ((int:= radix 10) @@ -973,7 +973,7 @@ MIT in each case. |# (define-standard-unary real:ceiling->exact flo:ceiling->exact rat:ceiling) (define-standard-unary real:truncate->exact flo:truncate->exact rat:truncate) (define-standard-unary real:round->exact flo:round->exact rat:round) - (define-standard-unary real:exact->inexact (lambda (x) x) rat:->flonum) + (define-standard-unary real:exact->inexact (lambda (x) x) rat:->inexact) (define-standard-unary real:inexact->exact flo:->rational (lambda (q) (if (rat:rational? q) @@ -987,9 +987,9 @@ MIT in each case. |# (IF (FLONUM? X) (IF (FLONUM? Y) (,flo:op X Y) - (,flo:op X (RAT:->FLONUM Y))) + (,flo:op X (RAT:->INEXACT Y))) (IF (FLONUM? Y) - (,flo:op (RAT:->FLONUM X) Y) + (,flo:op (RAT:->INEXACT X) Y) (,rat:op X Y))))))) (define-standard-binary real:+ flo:+ (copy rat:+)) (define-standard-binary real:- flo:- (copy rat:-)) @@ -1028,32 +1028,32 @@ MIT in each case. |# (if (flonum? x) (if (flonum? y) (if (flo:< x y) y x) - (if (rat:< (flo:->rational x) y) (rat:->flonum y) x)) + (if (rat:< (flo:->rational x) y) (rat:->inexact y) x)) (if (flonum? y) - (if (rat:< x (flo:->rational y)) y (rat:->flonum x)) + (if (rat:< x (flo:->rational y)) y (rat:->inexact x)) (if (rat:< x y) y x)))) (define (real:min x y) (if (flonum? x) (if (flonum? y) (if (flo:< x y) x y) - (if (rat:< (flo:->rational x) y) x (rat:->flonum y))) + (if (rat:< (flo:->rational x) y) x (rat:->inexact y))) (if (flonum? y) - (if (rat:< x (flo:->rational y)) (rat:->flonum x) y) + (if (rat:< x (flo:->rational y)) (rat:->inexact x) y) (if (rat:< x y) x y)))) (define (real:* x y) (cond ((flonum? x) (cond ((flonum? y) (flo:* x y)) ((rat:zero? y) y) - (else (flo:* x (rat:->flonum y))))) + (else (flo:* x (rat:->inexact y))))) ((rat:zero? x) x) - ((flonum? y) (flo:* (rat:->flonum x) y)) + ((flonum? y) (flo:* (rat:->inexact x) y)) (else ((copy rat:*) x y)))) (define (real:/ x y) - (cond ((flonum? x) (flo:/ x (if (flonum? y) y (rat:->flonum y)))) - ((flonum? y) (if (rat:zero? x) x (flo:/ (rat:->flonum x) y))) + (cond ((flonum? x) (flo:/ x (if (flonum? y) y (rat:->inexact y)))) + ((flonum? y) (if (rat:zero? x) x (flo:/ (rat:->inexact x) y))) (else ((copy rat:/) x y)))) (define (real:even? n) @@ -1074,13 +1074,13 @@ MIT in each case. |# (ERROR:WRONG-TYPE-ARGUMENT ,n FALSE ',operator-name))))) `(DEFINE (,name N M) (IF (FLONUM? N) - (INT:->FLONUM + (INT:->INEXACT (,operator ,(flo->int 'N) (IF (FLONUM? M) ,(flo->int 'M) M))) (IF (FLONUM? M) - (INT:->FLONUM (,operator N ,(flo->int 'M))) + (INT:->INEXACT (,operator N ,(flo->int 'M))) (,operator N M)))))))) (define-integer-binary real:quotient quotient int:quotient) (define-integer-binary real:remainder remainder int:remainder) @@ -1097,7 +1097,7 @@ MIT in each case. |# (macro (name operator) `(DEFINE (,name Q) (IF (FLONUM? Q) - (RAT:->FLONUM (,operator (FLO:->RATIONAL Q))) + (RAT:->INEXACT (,operator (FLO:->RATIONAL Q))) (,operator Q)))))) (define-rational-unary real:numerator rat:numerator) (define-rational-unary real:denominator rat:denominator)) @@ -1108,7 +1108,7 @@ MIT in each case. |# `(DEFINE (,name X) (IF (,hole? X) ,hole-value - (,function (REAL:->FLONUM X))))))) + (,function (REAL:->INEXACT X))))))) (define-transcendental-unary real:exp real:exact0= 1 flo:exp) (define-transcendental-unary real:log real:exact1= 0 flo:log) (define-transcendental-unary real:sin real:exact0= 0 flo:sin) @@ -1122,10 +1122,10 @@ MIT in each case. |# (if (and (real:exact0= y) (real:exact? x)) (if (real:negative? x) rec:pi 0) - (flo:atan2 (real:->flonum y) (real:->flonum x)))) + (flo:atan2 (real:->inexact y) (real:->inexact x)))) (define (rat:sqrt x) - (let ((guess (flo:sqrt (rat:->flonum x)))) + (let ((guess (flo:sqrt (rat:->inexact x)))) (if (int:integer? x) (let ((n (flo:round->exact guess))) (if (int:= x (int:* n n)) @@ -1139,10 +1139,10 @@ MIT in each case. |# (define (real:sqrt x) (if (flonum? x) (flo:sqrt x) (rat:sqrt x))) -(define (real:->flonum x) +(define (real:->inexact x) (if (flonum? x) x - (rat:->flonum x))) + (rat:->inexact x))) (define (real:->string x radix) (if (flonum? x) @@ -1187,9 +1187,9 @@ MIT in each case. |# (flo:/ flo:1 (exact-method (int:negate y)))) (else flo:1)))) (else - (general-case x (rat:->flonum y)))) + (general-case x (rat:->inexact y)))) (cond ((flonum? y) - (general-case (rat:->flonum x) y)) + (general-case (rat:->inexact x) y)) ((int:integer? y) (rat:expt x y)) ((and (rat:positive? x) @@ -1198,7 +1198,7 @@ MIT in each case. |# (if (int:= 2 d) (rat:sqrt x) (let ((guess - (flo:expt (rat:->flonum x) (rat:->flonum y)))) + (flo:expt (rat:->inexact x) (rat:->inexact y)))) (let ((q (if (int:integer? x) (flo:round->exact guess) @@ -1207,7 +1207,7 @@ MIT in each case. |# q guess)))))) (else - (general-case (rat:->flonum x) (rat:->flonum y))))))) + (general-case (rat:->inexact x) (rat:->inexact y))))))) (define (complex:complex? object) (or (recnum? object) ((copy real:real?) object))) -- 2.25.1