Skip to content
Snippets Groups Projects
Commit ed0c71e8 authored by pfdietz's avatar pfdietz
Browse files

Begin fixups to get around clisp problems with long floats

parent 3d80122b
No related branches found
No related tags found
No related merge requests found
...@@ -383,6 +383,9 @@ ...@@ -383,6 +383,9 @@
most-negative-double-float most-negative-double-float
most-negative-long-float) most-negative-long-float)
for one in '(1.0s0 1.0f0 1.0d0 1.0l0) for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
when (and (<= (abs (float-exponent lower-bound)) 500)
(<= (abs (float-exponent x)) 500)
(<= (abs (float-exponent bound)) 500))
when (<= (rational lower-bound) when (<= (rational lower-bound)
(rational x) (rational x)
(rational bound)) (rational bound))
...@@ -408,9 +411,15 @@ ...@@ -408,9 +411,15 @@
most-positive-double-float most-positive-double-float
most-positive-long-float) most-positive-long-float)
for one in '(1.0s0 1.0f0 1.0d0 1.0l0) for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
when (and (<= (abs (float-exponent bound)) 500)
(<= (abs (float-exponent x)) 500)
(<= (abs (float-exponent upper-bound)) 500))
when (<= (rational bound) when (<= (rational bound)
(rational x) (rational x)
(rational upper-bound)) (rational upper-bound))
;; do (print x)
;; (print epsilon) (print bound) (print upper-bound) (print one) (terpri)
;; (finish-output)
nconc nconc
(let* ((y (float x one)) (let* ((y (float x one))
(z (* y (- one (* 2 epsilon))))) (z (* y (- one (* 2 epsilon)))))
...@@ -432,6 +441,9 @@ ...@@ -432,6 +441,9 @@
most-positive-double-float most-positive-double-float
most-positive-long-float) most-positive-long-float)
for one in '(1.0s0 1.0f0 1.0d0 1.0l0) for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
when (and (<= (abs (float-exponent lower-bound)) 500)
(<= (abs (float-exponent x)) 500)
(<= (abs (float-exponent upper-bound)) 500))
when (<= (rational lower-bound) when (<= (rational lower-bound)
(rational x) (rational x)
(rational upper-bound)) (rational upper-bound))
...@@ -584,6 +596,9 @@ ...@@ -584,6 +596,9 @@
most-negative-double-float most-negative-double-float
most-negative-long-float) most-negative-long-float)
for one in '(1.0s0 1.0f0 1.0d0 1.0l0) for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
when (and (<= (abs (float-exponent lower-bound)) 500)
(<= (abs (float-exponent x)) 500)
(<= (abs (float-exponent bound)) 500))
when (<= (rational lower-bound) when (<= (rational lower-bound)
(rational x) (rational x)
(rational bound)) (rational bound))
...@@ -608,6 +623,9 @@ ...@@ -608,6 +623,9 @@
most-positive-double-float most-positive-double-float
most-positive-long-float) most-positive-long-float)
for one in '(1.0s0 1.0f0 1.0d0 1.0l0) for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
when (and (<= (abs (float-exponent bound)) 500)
(<= (abs (float-exponent x)) 500)
(<= (abs (float-exponent upper-bound)) 500))
when (<= (rational bound) when (<= (rational bound)
(rational x) (rational x)
(rational upper-bound)) (rational upper-bound))
...@@ -632,6 +650,9 @@ ...@@ -632,6 +650,9 @@
most-positive-double-float most-positive-double-float
most-positive-long-float) most-positive-long-float)
for one in '(1.0s0 1.0f0 1.0d0 1.0l0) for one in '(1.0s0 1.0f0 1.0d0 1.0l0)
when (and (<= (abs (float-exponent lower-bound)) 500)
(<= (abs (float-exponent x)) 500)
(<= (abs (float-exponent upper-bound)) 500))
when (<= (rational lower-bound) when (<= (rational lower-bound)
(rational x) (rational x)
(rational upper-bound)) (rational upper-bound))
......
...@@ -19,6 +19,52 @@ ...@@ -19,6 +19,52 @@
(eqlt (abs x) (abs y))) (eqlt (abs x) (abs y)))
(t (eqlt x y)))) (t (eqlt x y))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun rational-safely (x)
"Rational a floating point number, making sure the rational
number isn't 'too big'. This is important in implementations such
as clisp where the floating bounds can be very large."
(assert (floatp x))
(multiple-value-bind (significand exponent sign)
(integer-decode-float x)
(let ((limit 1000)
(radix (float-radix x)))
(cond
((< exponent (- limit))
(* significand (expt radix (- limit)) sign))
((> exponent limit)
(* significand (expt radix limit) sign))
(t (rational x)))))))
(defconstant +rational-most-negative-short-float+
(rational-safely most-negative-short-float))
(defconstant +rational-most-negative-single-float+
(rational-safely most-negative-single-float))
(defconstant +rational-most-negative-double-float+
(rational-safely most-negative-double-float))
(defconstant +rational-most-negative-long-float+
(rational-safely most-negative-long-float))
(defconstant +rational-most-positive-short-float+
(rational-safely most-positive-short-float))
(defconstant +rational-most-positive-single-float+
(rational-safely most-positive-single-float))
(defconstant +rational-most-positive-double-float+
(rational-safely most-positive-double-float))
(defconstant +rational-most-positive-long-float+
(rational-safely most-positive-long-float))
(defun float-exponent (x)
(if (floatp x)
(nth-value 1 (decode-float x))
0))
(defun numbers-are-compatible (x y) (defun numbers-are-compatible (x y)
(cond (cond
((complexp x) ((complexp x)
...@@ -33,21 +79,21 @@ ...@@ -33,21 +79,21 @@
(not (floatp y)) (not (floatp y))
(etypecase y (etypecase y
(short-float (short-float
(<= #.(rational most-negative-short-float) (<= +rational-most-negative-short-float+
x x
#.(rational most-positive-short-float))) +rational-most-positive-short-float+))
(single-float (single-float
(<= #.(rational most-negative-single-float) (<= +rational-most-negative-single-float+
x x
#.(rational most-positive-single-float))) +rational-most-positive-single-float+))
(double-float (double-float
(<= #.(rational most-negative-double-float) (<= +rational-most-negative-double-float+
x x
#.(rational most-positive-double-float))) +rational-most-positive-double-float+))
(long-float (long-float
(<= #.(rational most-negative-long-float) (<= +rational-most-negative-long-float+
x x
#.(rational most-positive-long-float)))))))) +rational-most-positive-long-float+)))))))
;;; NOTE! According to section 12.1.4.1, when a rational is compared ;;; NOTE! According to section 12.1.4.1, when a rational is compared
;;; to a float, the effect is as if the float is convert to a rational ;;; to a float, the effect is as if the float is convert to a rational
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment