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.

diff --git a/src/runtime/primitive-arithmetic.scm b/src/runtime/primitive-arithmetic.scm
index bbe4b8af413358ac45d7e08ea53d3a427b0d4664..af3b0f8341f6a8dcfdc11e07eb6d063921978359 100644 (file)
--- 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 e9730c18a8a266a87a58ad9bf8408af683943d75..ff82933cec261a8fa7ae6393082796760a3e8777 100644 (file)
--- 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))