From 682178dbb3ad5dbd4e789fb7d6d6321d3ad154d8 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Mon, 5 Nov 2018 04:41:14 +0000 Subject: [PATCH] Fix sign of (flo:ulp -infinity). Simplify. flo:ulp is supposed to return a positive magnitude, in particular the absolute distance from x to the next larger floating-point number in magnitude. --- src/runtime/primitive-arithmetic.scm | 15 +++++++++------ tests/runtime/test-arith.scm | 6 +++++- 2 files changed, 14 insertions(+), 7 deletions(-) diff --git a/src/runtime/primitive-arithmetic.scm b/src/runtime/primitive-arithmetic.scm index bbe4b8af4..af3b0f834 100644 --- a/src/runtime/primitive-arithmetic.scm +++ b/src/runtime/primitive-arithmetic.scm @@ -249,14 +249,17 @@ USA. (eq? (flo:safe-negative? x) (flo:safe-negative? y))))) +;;; Measure the distance from x to the next floating-point number of +;;; the same sign as x and larger in magnitude. For +/-0, this yields +;;; the smallest subnormal. For +/-inf, this yields +inf. For NaN +;;; this yields some NaN. + (define (flo:ulp x) - ;; Measure the distance from x to the next float in the direction of - ;; the sign of x. (if (flo:finite? x) - (let* ((direction (flo:copysign (flo:+inf.0) x)) - (x* (flo:nextafter x direction))) - (flo:* (flo:copysign 1. x) (flo:- x* x))) - x)) + (let* ((x0 (flo:abs x)) + (x1 (flo:nextafter x0 (flo:+inf.0)))) + (flo:- x1 x0)) + (flo:+inf.0))) (define (int:->flonum n) ((ucode-primitive integer->flonum 2) n #b10)) diff --git a/tests/runtime/test-arith.scm b/tests/runtime/test-arith.scm index e9730c18a..ff82933ce 100644 --- a/tests/runtime/test-arith.scm +++ b/tests/runtime/test-arith.scm @@ -119,13 +119,17 @@ USA. (define-enumerated-test 'flo:ulp (vector - (vector (flo:-inf.0) (flo:-inf.0)) + (vector (flo:-inf.0) (flo:+inf.0)) + (vector (+ -3. (* 2 flo:ulp-of-one)) (* 2 flo:ulp-of-one)) + (vector -3. (* 2 flo:ulp-of-one)) (vector -2. (* 2 flo:ulp-of-one)) (vector -1. flo:ulp-of-one) (vector -0. "4.9406564584124654e-324") (vector 0. "4.9406564584124654e-324") (vector 1. flo:ulp-of-one) (vector 2. (* 2 flo:ulp-of-one)) + (vector 3. (* 2 flo:ulp-of-one)) + (vector (- 3. (* 2 flo:ulp-of-one)) (* 2 flo:ulp-of-one)) (vector (flo:+inf.0) (flo:+inf.0))) (lambda (v) (let ((x (vector-ref v 0)) -- 2.25.1