[Git][cmucl/cmucl][rtoy-fix-59-derive-decode-float] 3 commits: Fix typo. double-double-float is in the kernel package
Raymond Toy
rtoy at common-lisp.net
Sun Feb 4 16:20:04 UTC 2018
Raymond Toy pushed to branch rtoy-fix-59-derive-decode-float at cmucl / cmucl
Commits:
2292400e by Raymond Toy at 2018-02-04T08:16:35-08:00
Fix typo. double-double-float is in the kernel package
- - - - -
4e58e53c by Raymond Toy at 2018-02-04T08:19:13-08:00
Be more careful in computing the decode-float bounds
If 0 is the lower bound then the smallest exponent is not for 0, but
for the least positive float because of denormals.
Also handle exclusive bounds.
- - - - -
7b336362 by Raymond Toy at 2018-02-04T08:19:37-08:00
Add more tests decode-float.
- - - - -
3 changed files:
- src/compiler/float-tran.lisp
- tests/float-tran.lisp
- tests/issues.lisp
Changes:
=====================================
src/compiler/float-tran.lisp
=====================================
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -2031,29 +2031,33 @@
(labels
((calc-exp (x)
(when x
- (nth-value 1 (decode-float x))))
- (min-exp ()
- ;; Use decode-float on the least positive float of the
- ;; appropriate type to find the min exponent. If we don't
- ;; know the actual number format, use double, which has the
- ;; widest range (including double-double-float).
- (calc-exp (if (eq 'single-float (numeric-type-format arg))
- least-positive-single-float
- least-positive-double-float)))
- (max-exp ()
+ (bound-func #'(lambda (arg)
+ (nth-value 1 (decode-float arg)))
+ x)))
+ (min-exp (interval)
+ ;; (decode-float 0d0) returns an exponent of -1022. But
+ ;; (decode-float least-positive-double-float returns -1073.
+ ;; Hence, if the low value is less than this, we need to
+ ;; return the exponent of the least positive number.
+ (let ((least (if (eq 'single-float (numeric-type-format arg))
+ least-positive-single-float
+ least-positive-double-float)))
+ (if (or (interval-contains-p 0 interval)
+ (interval-contains-p least interval))
+ (calc-exp least)
+ (calc-exp (bound-value (interval-low interval))))))
+ (max-exp (interval)
;; Use decode-float on the most postive number of the
;; appropriate type to find the max exponent. If we don't
;; know the actual number format, use double, which has the
;; widest range (including double-double-float).
- (calc-exp (if (eq 'single-float (numeric-type-format arg))
- most-positive-single-float
- most-positive-double-float))))
- (let* ((interval (interval-func #'calc-exp
- (interval-abs (numeric-type->interval arg))))
- (lo (or (interval-low interval)
- (min-exp)))
- (hi (or (interval-high interval)
- (max-exp))))
+ (or (calc-exp (bound-value (interval-high interval)))
+ (calc-exp (if (eq 'single-float (numeric-type-format arg))
+ most-positive-single-float
+ most-positive-double-float)))))
+ (let* ((interval (interval-abs (numeric-type->interval arg)))
+ (lo (min-exp interval))
+ (hi (max-exp interval)))
(specifier-type `(integer ,(or lo '*) ,(or hi '*))))))
(defun decode-float-sign-derive-type-aux (arg)
=====================================
tests/float-tran.lisp
=====================================
--- a/tests/float-tran.lisp
+++ b/tests/float-tran.lisp
@@ -28,7 +28,7 @@
#+double-double
(assert-equalp (c::specifier-type '(integer -1073 1024))
(c::decode-float-exp-derive-type-aux
- (c::specifier-type 'double-double-float)))
+ (c::specifier-type 'kernel:double-double-float)))
(assert-equalp (c::specifier-type '(integer 2 8))
(c::decode-float-exp-derive-type-aux
(c::specifier-type '(double-float 2d0 128d0)))))
=====================================
tests/issues.lisp
=====================================
--- a/tests/issues.lisp
+++ b/tests/issues.lisp
@@ -450,3 +450,57 @@
(declare (type (double-float -2d0 0d0) z))
(nth-value 2 (decode-float z))))))
(assert-equal -1d0 (funcall f -1d0))))
+
+(define-test issue.59.1-double
+ (:tag :issues)
+ (dolist (entry '(((-2d0 2d0) (-1073 2))
+ ((-2d0 0d0) (-1073 2))
+ ((0d0 2d0) (-1073 2))
+ ((1d0 4d0) (1 3))
+ ((-4d0 -1d0) (1 3))
+ (((0d0) (10d0)) (-1073 4))
+ ((-2f0 2f0) (-148 2))
+ ((-2f0 0f0) (-148 2))
+ ((0f0 2f0) (-148 2))
+ ((1f0 4f0) (1 3))
+ ((-4f0 -1f0) (1 3))
+ ((0f0) (10f0)) (-148 4)))
+ (destructuring-bind ((arg-lo arg-hi) (result-lo result-hi))
+ entry
+ (assert-equalp (c::specifier-type `(integer ,result-lo ,result-hi))
+ (c::decode-float-exp-derive-type-aux
+ (c::specifier-type `(double-float ,arg-lo ,arg-hi)))))))
+
+(define-test issue.59.1-double
+ (:tag :issues)
+ (dolist (entry '(((-2d0 2d0) (-1073 2))
+ ((-2d0 0d0) (-1073 2))
+ ((0d0 2d0) (-1073 2))
+ ((1d0 4d0) (1 3))
+ ((-4d0 -1d0) (1 3))
+ (((0d0) (10d0)) (-1073 4))
+ (((0.5d0) (4d0)) (0 3))))
+ (destructuring-bind ((arg-lo arg-hi) (result-lo result-hi))
+ entry
+ (assert-equalp (c::specifier-type `(integer ,result-lo ,result-hi))
+ (c::decode-float-exp-derive-type-aux
+ (c::specifier-type `(double-float ,arg-lo ,arg-hi)))
+ arg-lo
+ arg-hi))))
+
+(define-test issue.59.1-float
+ (:tag :issues)
+ (dolist (entry '(((-2f0 2f0) (-148 2))
+ ((-2f0 0f0) (-148 2))
+ ((0f0 2f0) (-148 2))
+ ((1f0 4f0) (1 3))
+ ((-4f0 -1f0) (1 3))
+ (((0f0) (10f0)) (-148 4))
+ (((0.5f0) (4f0)) (0 3))))
+ (destructuring-bind ((arg-lo arg-hi) (result-lo result-hi))
+ entry
+ (assert-equalp (c::specifier-type `(integer ,result-lo ,result-hi))
+ (c::decode-float-exp-derive-type-aux
+ (c::specifier-type `(single-float ,arg-lo ,arg-hi)))
+ arg-lo
+ arg-hi))))
\ No newline at end of file
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/62c5f3e9a170e5f8799f37b3a167f19bd3741db7...7b336362b683234da87f18f4167cd8ecb8613f9b
---
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/62c5f3e9a170e5f8799f37b3a167f19bd3741db7...7b336362b683234da87f18f4167cd8ecb8613f9b
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/20180204/6e1d9de4/attachment-0001.html>
More information about the cmucl-cvs
mailing list