[Git][cmucl/cmucl][issue-156-take-2-nan-comparison] Fix errors in dd >= and <= implmeentation

[Raymond Toy (@rtoy)]

Raymond Toy pushed to branch issue-156-take-2-nan-comparison at cmucl / cmucl


Commits:
64c9296f by Raymond Toy at 2023-03-09T19:49:21-08:00
Fix errors in dd >= and <= implmeentation

For `dd<=`, we accidentally used `dd>` instead of `dd<`.   Oops.

The deftransforms had swapped the args because of a previous
implementation that we changed, but we forgot to revert the swapping.

Now `(describe decode-float)` correctly returns
```
  (VALUES
   (OR (SINGLE-FLOAT 0.5 (1.0))
       (DOUBLE-FLOAT 0.5d0 (1.0d0))
       (DOUBLE-DOUBLE-FLOAT 0.5w0 (1.0w0)))
   KERNEL:DOUBLE-FLOAT-EXPONENT
   (OR (SINGLE-FLOAT 1.0 1.0)
       (SINGLE-FLOAT -1.0 -1.0)
       (DOUBLE-FLOAT -1.0d0 -1.0d0)
       (DOUBLE-FLOAT 1.0d0 1.0d0)
       (DOUBLE-DOUBLE-FLOAT -1.0w0 -1.0w0)
       (DOUBLE-DOUBLE-FLOAT 1.0w0 1.0w0)))
```
like we used to.

- - - - -


1 changed file:

- src/compiler/float-tran-dd.lisp


Changes:

=====================================
src/compiler/float-tran-dd.lisp
=====================================
@@ -670,7 +670,7 @@
 
 (declaim (inline dd<=))
 (defun dd<= (a0 a1 b0 b1)
-  (or (dd> a0 a1 b0 b1)
+  (or (dd< a0 a1 b0 b1)
       (dd= a0 a1 b0 b1)))
 
 (declaim (inline dd>=))
@@ -699,15 +699,15 @@
 	(kernel:double-double-lo b)))
 
 (deftransform <= ((a b) (vm::double-double-float vm::double-double-float) *)
-  `(dd<= (kernel:double-double-hi b)
-	 (kernel:double-double-lo b)
-	 (kernel:double-double-hi a)
-	 (kernel:double-double-lo a)))
+  `(dd<= (kernel:double-double-hi a)
+	 (kernel:double-double-lo a)
+	 (kernel:double-double-hi b)
+	 (kernel:double-double-lo b)))
 
 
 (deftransform >= ((a b) (vm::double-double-float vm::double-double-float) *)
-  `(dd>= (kernel:double-double-hi b)
-	 (kernel:double-double-lo b)
-	 (kernel:double-double-hi a)
-	 (kernel:double-double-lo a)))
+  `(dd>= (kernel:double-double-hi a)
+	 (kernel:double-double-lo a)
+	 (kernel:double-double-hi b)
+	 (kernel:double-double-lo b)))
 ) ; end progn



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/64c9296fa3ff2c5a0b8fd5d5f0199996f2a3ea2b

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/64c9296fa3ff2c5a0b8fd5d5f0199996f2a3ea2b
You're receiving this email because of your account on gitlab.common-lisp.net.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20230310/981fb568/attachment-0001.html>