Don't transform (- x) into (- 0 x).

The transformation is wrong for floating-point signed zero.

diff --git a/src/sf/usiexp.scm b/src/sf/usiexp.scm
index 3eb298868b289d8f354a1b894afa80df46f79cf9..b9f3fe10de51f85165e9c0884e5124ebb777677f 100644 (file)
--- a/src/sf/usiexp.scm
+++ b/src/sf/usiexp.scm
@@ -274,19 +274,21 @@ USA.
 \f
 (define (right-accumulation-inverse identity inverse-expansion make-binary)
   (lambda (expr operands block)
-    (let ((expand
-          (lambda (expr x y)
-             (if (constant-eq? y identity)
-                 x
-                 (make-binary expr block x y)))))
-      (cond ((null? operands) #f)
-           ((null? (cdr operands))
-            (expand expr (constant/make #f identity) (car operands)))
-           (else
-            (let ((inverse (inverse-expansion #f (cdr operands) block)))
-              (if inverse
-                  (expand expr (car operands) inverse)
-                  #f)))))))
+    (cond ((null? operands) #f)
+         ((null? (cdr operands))
+          (let ((y (car operands)))
+            (if (constant-eq? y identity)
+                (constant/make #f identity)
+                ;; Converting (- x) to (- 0 x) breaks signed zero.
+                #f)))
+         ((inverse-expansion #f (cdr operands) block)
+          => (lambda (inverse)
+               (let ((x (car operands))
+                     (y inverse))
+                 (if (constant-eq? inverse identity)
+                     x
+                     (make-binary expr block x y)))))
+         (else #f))))
 
 (define --expansion
   (right-accumulation-inverse 0 +-expansion

diff --git a/tests/runtime/test-arith.scm b/tests/runtime/test-arith.scm
index 312b43b66f97a2e4f6395c936649ee6af4841655..8f60ea75fb943cd4ec65c6e1a31a68bed5b09ec0 100644 (file)
--- a/tests/runtime/test-arith.scm
+++ b/tests/runtime/test-arith.scm
@@ -374,7 +374,5 @@ USA.
   (lambda (v)
     (let ((x (vector-ref v 0))
           (y (vector-ref v 1)))
-      (if (flo:= -1. (flo:copysign 1. x))
-          (assert-eqv (- x) y)
-          (expect-failure (lambda () (assert-eqv (- x) y))))
+      (assert-eqv (- x) y)
       (assert-eqv (- 0 (flo:copysign 1. x)) (flo:copysign 1. y)))))
\ No newline at end of file