Rename flo:safe-negative? -> flo:sign-negative?.

It was confusing that (flo:safe< x 0.) was not the same as
(flo:safe-negative? x) -- they disagree on -0 and NaN values with
negative sign bits.

diff --git a/src/relnotes/flonum b/src/relnotes/flonum
index e42ef8fb67d2aacaf5513af58bd02cec5fd2a667..2bac81afbdc345877f50f24a5c763138daeebeeb 100644 (file)
--- a/src/relnotes/flonum
+++ b/src/relnotes/flonum
@@ -64,11 +64,11 @@ New flonum-related definitions:
 - (flo:safe-zero? x) is true if x is zero; false if subnormal, normal,
   infinite, or NaN.  flo:zero? raises an invalid-operation exception on
   NaN; flo:safe-zero? never does even on signalling NaN.
-- (flo:safe-negative? x) returns true if x has negative sign, false if
+- (flo:sign-negative? x) returns true if x has negative sign, false if
   x has positive sign.  Note that (flo:negative? 0.) and (flo:negative?
-  -0.) both return false, while (flo:safe-negative? -0.) returns true.
+  -0.) both return false, while (flo:sign-negative? -0.) returns true.
   Also, flo:negative? raises invalid-operation exception on NaN, while
-  flo:safe-negative? never does even on signalling NaN.
+  flo:sign-negative? never does even on signalling NaN.
 - (flo:safe< x y), (flo:safe<= x y), (flo:safe> x y), (flo:safe>= x y),
   (flo:safe= x y), (flo:safe<> x y), (flo:unordered? x y) perform
   unordered floating-point comparisons and, unlike flo:< &c., do not

diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm
index 7243e2e86e365cb3e1ba743655f6886b093086bc..2ac8c786bad41baa2aab7e7d3b648ee4153507b9 100644 (file)
--- a/src/runtime/arith.scm
+++ b/src/runtime/arith.scm
@@ -1328,14 +1328,14 @@ USA.
         (flo:copysign x (real:->inexact y)))
        (else
         (if (if (flonum? y)
-                (flo:safe-negative? y)
+                (flo:sign-negative? y)
                 (rat:negative? y))
             (- (rat:abs x))
             (rat:abs x)))))
 
-(define (real:safe-negative? x)
+(define (real:sign-negative? x)
   (if (flonum? x)
-      (flo:safe-negative? x)
+      (flo:sign-negative? x)
       ((copy rat:negative?) x)))
 \f
 (define-syntax define-transcendental-unary

diff --git a/src/runtime/dragon4.scm b/src/runtime/dragon4.scm
index 89c626097cb4fbf1f3b009ee8e899e0d077b0474..fbfd68c04813d13e6f34cd750289b8993726e3f9 100644 (file)
--- a/src/runtime/dragon4.scm
+++ b/src/runtime/dragon4.scm
@@ -101,7 +101,7 @@ not much different to numbers within a few orders of magnitude of 1.
                     "-inf.0"
                     (string-append "-" (x>0 x)))))
              ((flo:zero? x)
-              (if (flo:safe-negative? x) "-0." "0."))
+              (if (flo:sign-negative? x) "-0." "0."))
              (else
               "+nan.0")))))
 

diff --git a/src/runtime/primitive-arithmetic.scm b/src/runtime/primitive-arithmetic.scm
index 24ac07106ba9d98eed2309ea8ea3794a673d809c..ed5448dfa14022569c66dae10f17a618fc723599 100644 (file)
--- a/src/runtime/primitive-arithmetic.scm
+++ b/src/runtime/primitive-arithmetic.scm
@@ -162,7 +162,7 @@ USA.
   (flo:infinite? flonum-is-infinite? 1)
   (flo:nan? flonum-is-nan? 1)
   (flo:normal? flonum-is-normal? 1)
-  (flo:safe-negative? flonum-is-negative? 1)
+  (flo:sign-negative? flonum-is-negative? 1)
   (flo:safe-zero? flonum-is-zero? 1)
   (flo:= flonum-equal? 2)
   (flo:< flonum-less? 2)
@@ -241,17 +241,17 @@ USA.
       ;; signalling NaN.
       (cond ((not (flo:nan? y))
              (assert (flo:nan? x))
-             (if (flo:safe-negative? x) -1 +1))
+             (if (flo:sign-negative? x) -1 +1))
             ((not (flo:nan? x))
              (assert (flo:nan? y))
-             (if (flo:safe-negative? y) +1 -1))
+             (if (flo:sign-negative? y) +1 -1))
             (else
              (assert (flo:nan? x))
              (assert (flo:nan? y))
-             (let ((x- (flo:safe-negative? x))
+             (let ((x- (flo:sign-negative? x))
                    (xq (flo:nan-quiet? x))
                    (xp (flo:nan-payload x))
-                   (y- (flo:safe-negative? y))
+                   (y- (flo:sign-negative? y))
                    (yq (flo:nan-quiet? y))
                    (yp (flo:nan-payload y)))
                (cond ((not (eq? x- y-)) (if x- -1 +1))
@@ -268,9 +268,9 @@ USA.
             (else
             ;; -0. < +0.
              (assert (flo:zero? y))
-             (if (flo:safe-negative? x)
-                 (if (flo:safe-negative? y) 0 -1)
-                 (if (flo:safe-negative? y) +1 0))))))
+             (if (flo:sign-negative? x)
+                 (if (flo:sign-negative? y) 0 -1)
+                 (if (flo:sign-negative? y) +1 0))))))
 
 (define (flo:total-order-mag x y)
   (flo:total-order (flo:abs x) (flo:abs y)))
@@ -281,17 +281,17 @@ USA.
       ;; signalling NaN.
       (cond ((not (flo:nan? y))
             (assert (flo:nan? x))
-            (flo:safe-negative? x))
+            (flo:sign-negative? x))
            ((not (flo:nan? x))
             (assert (flo:nan? y))
-            (not (flo:safe-negative? y)))
+            (not (flo:sign-negative? y)))
            (else
             (assert (flo:nan? x))
             (assert (flo:nan? y))
-            (let ((x- (flo:safe-negative? x))
+            (let ((x- (flo:sign-negative? x))
                   (xq (flo:nan-quiet? x))
                   (xp (flo:nan-payload x))
-                  (y- (flo:safe-negative? y))
+                  (y- (flo:sign-negative? y))
                   (yq (flo:nan-quiet? y))
                   (yp (flo:nan-payload y)))
               (cond ((not (eq? x- y-)) (and x- (not y-)))
@@ -310,8 +310,8 @@ USA.
            (else
             ;; -0. < +0.
             (assert (flo:zero? y))
-            (and (flo:safe-negative? x)
-                 (not (flo:safe-negative? y)))))))
+            (and (flo:sign-negative? x)
+                 (not (flo:sign-negative? y)))))))
 
 (define (flo:total-mag< x y)
   (flo:total< (flo:abs x) (flo:abs y)))
@@ -366,8 +366,8 @@ USA.
        (not (flo:nan? y))
        (flo:= x y)
        (or (not (flo:zero? x))
-          (eq? (flo:safe-negative? x)
-               (flo:safe-negative? y)))))
+          (eq? (flo:sign-negative? x)
+               (flo:sign-negative? y)))))
 \f
 ;;; 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

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 71c552823c8f2cef2490c38cb14e218a98f691a5..7c558c60b47e3658381f1a29d943e0c6efed1310 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -348,7 +348,6 @@ USA.
          flo:qnan?
          flo:round
          flo:round->exact
-         flo:safe-negative?
          flo:safe-zero?
          flo:safe<
          flo:safe<=
@@ -356,6 +355,7 @@ USA.
          flo:safe=
          flo:safe>
          flo:safe>=
+         flo:sign-negative?
          flo:sin
          flo:sinh
          flo:snan

diff --git a/src/sf/gconst.scm b/src/sf/gconst.scm
index bf1e870b10517ebd4f442b71e674469267458a76..f0f92e8a53b9194f328d5f9b29df3c6df5f061a9 100644 (file)
--- a/src/sf/gconst.scm
+++ b/src/sf/gconst.scm
@@ -144,12 +144,12 @@ USA.
     (flo:positive? flonum-positive?)
     (flo:round flonum-round)
     (flo:round->exact flonum-round->exact)
-    (flo:safe-negative? flonum-is-negative?)
     (flo:safe< flonum-is-less?)
     (flo:safe<= flonum-is-less-or-equal?)
     (flo:safe<> flonum-is-less-or-greater?)
     (flo:safe> flonum-is-greater?)
     (flo:safe>= flonum-is-greater-or-equal?)
+    (flo:sign-negative? flonum-is-negative?)
     (flo:sin flonum-sin)
     (flo:sqrt flonum-sqrt)
     (flo:tan flonum-tan)

diff --git a/tests/runtime/test-arith.scm b/tests/runtime/test-arith.scm
index 82cf23ebfad57e673c6a3a1c7e728dbddad27768..379dc8215547be9d598ffdfe4c06e7443862775d 100644 (file)
--- a/tests/runtime/test-arith.scm
+++ b/tests/runtime/test-arith.scm
@@ -60,7 +60,7 @@ USA.
   (if (and (flo:flonum? x) (flo:nan? x))
       (and (flo:flonum? y)
            (flo:nan? y)
-           (eqv? (flo:safe-negative? x) (flo:safe-negative? y))
+           (eqv? (flo:sign-negative? x) (flo:sign-negative? y))
            (eqv? (flo:nan-quiet? x) (flo:nan-quiet? y))
            (eqv? (flo:nan-payload x) (flo:nan-payload y)))
       (and (not (and (flo:flonum? y) (flo:nan? y)))

diff --git a/tests/runtime/test-flonum.scm b/tests/runtime/test-flonum.scm
index 4bd8469e3a6ae17ceea469e0b7c6b1b44be15a5a..21b4fb94e7d31bc83c1d546ae311ba2bbe9fcad0 100644 (file)
--- a/tests/runtime/test-flonum.scm
+++ b/tests/runtime/test-flonum.scm
@@ -71,7 +71,7 @@ USA.
 (define (eqv-nan? x y)
   (if (flo:nan? x)
       (and (flo:nan? y)
-           (eqv? (flo:safe-negative? x) (flo:safe-negative? y))
+           (eqv? (flo:sign-negative? x) (flo:sign-negative? y))
            (eqv? (flo:nan-quiet? x) (flo:nan-quiet? y))
            (eqv? (flo:nan-payload x) (flo:nan-payload y)))
       (and (not (flo:nan? y))
@@ -512,7 +512,7 @@ USA.
   (lambda (x v)
     (assert-eqv (yes-traps (lambda () (flo:nan? x))) v)))
 
-(define-enumerated-test 'safe-negative?   ;XXX Maybe call it signbit?
+(define-enumerated-test 'sign-negative?
   `((-inf.0 #t)
     (-1. #t)
     (,subnormal- #t)
@@ -524,7 +524,7 @@ USA.
     ;; (+nan.0 ...)  ; indeterminate
     )
   (lambda (x n?)
-    (assert-eqv (yes-traps (lambda () (flo:safe-negative? x))) n?)))
+    (assert-eqv (yes-traps (lambda () (flo:sign-negative? x))) n?)))
 
 (define-syntax define-comparison-test
   (syntax-rules ()
@@ -823,7 +823,7 @@ USA.
       (if quiet?
           (assert-qnan nan)
           (assert-snan nan))
-      (assert-eqv (flo:safe-negative? nan) negative?)
+      (assert-eqv (flo:sign-negative? nan) negative?)
       (assert-eqv (flo:nan-quiet? nan) quiet?)
       (assert-eqv (flo:nan-payload nan) payload))))
 
@@ -956,7 +956,7 @@ USA.
     (with-expected-failure xfail
       (lambda ()
         (let ((y (yes-traps (lambda () (flo:abs x)))))
-          (assert-false (flo:safe-negative? y))
+          (assert-false (flo:sign-negative? y))
           (assert-eqv (flo:classify y) (flo:classify x))
           (if (flo:nan? x)
               (begin
@@ -991,8 +991,8 @@ USA.
         (let ((y (yes-traps (lambda () (flo:negate x)))))
           (assert-eqv-nan y z)
           (assert-eqv-nan (flo:abs x) (flo:abs y))
-          (assert-eqv (flo:safe-negative? y)
-                      (not (flo:safe-negative? x)))
+          (assert-eqv (flo:sign-negative? y)
+                      (not (flo:sign-negative? x)))
           (assert-eqv (flo:classify y) (flo:classify x))
           (if (flo:nan? x)
               (begin