Commit 90df7817 authored by Raymond Toy's avatar Raymond Toy

Merge branch 'rtoy-fix-59-derive-decode-float' into 'master'

Fix #59: derive decode float

Closes #59

See merge request !34
parents e7f97a5d 7b336362
Pipeline #281 passed with stage
in 12 minutes and 50 seconds
......@@ -2028,31 +2028,36 @@
(defun decode-float-exp-derive-type-aux (arg)
;; Derive the exponent part of the float. It's always an integer
;; type.
(flet ((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).
(nth-value 1 (decode-float (if (eq 'single-float (numeric-type-format arg))
least-positive-single-float
least-positive-double-float))))
(max-exp ()
;; 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).
(if (eq (numeric-type-format arg) 'single-float)
(nth-value 1 (decode-float most-positive-single-float))
(nth-value 1 (decode-float most-positive-double-float)))))
(let* ((lo (or (bound-func #'calc-exp
(numeric-type-low arg))
(min-exp)))
(hi (or (bound-func #'calc-exp
(numeric-type-high arg))
(max-exp))))
(labels
((calc-exp (x)
(when x
(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).
(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)
......
......@@ -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)))))
......
......@@ -443,3 +443,64 @@
(write (read-from-string "`(,@vars ,@vars)")
:pretty t
:stream s)))))
(define-test issue.59
(:tag :issues)
(let ((f (compile nil #'(lambda (z)
(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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment