From: Taylor R Campbell Date: Fri, 30 Nov 2018 07:19:49 +0000 (+0000) Subject: Rename flo:safe-negative? -> flo:sign-negative?. X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~93 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=7ccf82a90fae8360038948f3ec9174b005c707c1;p=mit-scheme.git 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 e42ef8fb6..2bac81afb 100644 --- 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 7243e2e86..2ac8c786b 100644 --- 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))) (define-syntax define-transcendental-unary diff --git a/src/runtime/dragon4.scm b/src/runtime/dragon4.scm index 89c626097..fbfd68c04 100644 --- 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 24ac07106..ed5448dfa 100644 --- 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))))) ;;; 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 71c552823..7c558c60b 100644 --- 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 bf1e870b1..f0f92e8a5 100644 --- 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 82cf23ebf..379dc8215 100644 --- 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 4bd8469e3..21b4fb94e 100644 --- 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