Define (flo:ulp x) to be distance to next float in direction of x.

Thus, (flo:ulp 1.) = (flo:ulp -1.) = flo:ulp-of-one.  Bottoms out at
infinity: (flo:ulp x) = x if x is infinite.  This definition applies
to zero, too, giving the smallest subnormal.

diff --git a/src/runtime/primitive-arithmetic.scm b/src/runtime/primitive-arithmetic.scm
index aa00cf993fe788f695576cc51ee40d2110266c27..bbe4b8af413358ac45d7e08ea53d3a427b0d4664 100644 (file)
--- a/src/runtime/primitive-arithmetic.scm
+++ b/src/runtime/primitive-arithmetic.scm
@@ -249,6 +249,15 @@ USA.
           (eq? (flo:safe-negative? x)
                (flo:safe-negative? y)))))
 
+(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))
+
 (define (int:->flonum n)
   ((ucode-primitive integer->flonum 2) n #b10))
 

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 7b3c89686405eaad06da1fcb36fc09e593b7993c..bb69b109b5bc2c376b41f7dcc2b03af367e75a2a 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -345,6 +345,7 @@ USA.
          flo:tanh
          flo:truncate
          flo:truncate->exact
+         flo:ulp
          flo:unordered?
          flo:vector-cons
          flo:vector-length

diff --git a/tests/runtime/test-arith.scm b/tests/runtime/test-arith.scm
index 5237363576fc6d93f494b52ad7dce547165980ce..e9730c18a8a266a87a58ad9bf8408af683943d75 100644 (file)
--- a/tests/runtime/test-arith.scm
+++ b/tests/runtime/test-arith.scm
@@ -117,6 +117,27 @@ USA.
   (vector (flo:-inf.0) -2. -1 -0. 0 +0. +1 +2. (flo:+inf.0))
   (lambda (v) (assert-nan (/ v (flo:nan.0)))))
 
+(define-enumerated-test 'flo:ulp
+  (vector
+   (vector (flo:-inf.0) (flo:-inf.0))
+   (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 (flo:+inf.0) (flo:+inf.0)))
+  (lambda (v)
+    (let ((x (vector-ref v 0))
+          (u (vector-ref v 1)))
+      (flo:with-trapped-exceptions 0
+        (lambda ()
+          (let ((u
+                 (if (string? u)
+                     (string->number u)
+                     u)))
+            (assert-eqv (flo:ulp x) u)))))))
+
 (define-enumerated-test 'log1p-exact
   (vector
    (cons 0 0)