Commit 65b62a2b authored by Mark Evenson's avatar Mark Evenson

[IN PROGRESS] Fix the numeric tower for floats

(Robert Dodier)

Address problems with DECODE-FLOAT

Includes all known patches from Robert Dodier.

Robert Dodier

References
<https://github.com/armedbear/abcl/issues/93>
<https://github.com/armedbear/abcl/issues/94>
<https://github.com/armedbear/abcl/issues/95>
parent 4d16d099
......@@ -153,11 +153,34 @@
:format-arguments (list float))))
(defun decode-float (float)
(multiple-value-bind (significand exponent sign)
(integer-decode-float float)
(values (coerce (/ significand (expt 2 53)) 'float)
(+ exponent 53)
(if (minusp sign) -1.0 1.0))))
(cond
((typep float 'single-float)
(decode-float-single float))
((typep float 'double-float)
(decode-float-double float))
(t
(error 'simple-type-error
:format-control "~S is neither SINGLE-FLOAT nor DOUBLE-FLOAT."
:format-arguments (list float)))))
(defun decode-float-single (float)
;; TODO memoize
(let ((float-precision-single (float-precision 1f0)))
(multiple-value-bind (significand exponent sign)
(integer-decode-float float)
(values (coerce (/ significand (expt 2 float-precision-single)) 'single-float)
(+ exponent float-precision-single)
(if (minusp sign) -1f0 1f0)))))
(defun decode-float-double (float)
;; TODO memoize
(let ((float-precision-double (float-precision 1d0)))
(multiple-value-bind (significand exponent sign)
(integer-decode-float float)
(values (coerce (/ significand (expt 2 float-precision-double)) 'double-float)
(+ exponent float-precision-double)
(if (minusp sign) -1d0 1d0)))))
(defun conjugate (number)
(etypecase number
......
(in-package :cl-user)
;;; <https://github.com/armedbear/abcl/issues/93>
(let ((floats `(1f6
(let ((floats `(1f0
1f6
1f-6
,least-positive-normalized-single-float
,least-positive-single-float)))
......@@ -42,4 +43,11 @@
(let ((result (decode-float float)))
(prove:is-type result 'double-float))))
;;; additional things along the way…
#|
Should fail, as you shouldn't be able to
(decode-float single-float-positive-infinity)
|#
(prove:finalize)
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