From ed0c71e8b3b6fc77ed02d50c26f53897dec98a3e Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Thu, 5 Feb 2004 13:00:11 +0000 Subject: [PATCH] Begin fixups to get around clisp problems with long floats --- ansi-tests/number-comparison.lsp | 21 +++++++++++ ansi-tests/numbers-aux.lsp | 62 +++++++++++++++++++++++++++----- 2 files changed, 75 insertions(+), 8 deletions(-) diff --git a/ansi-tests/number-comparison.lsp b/ansi-tests/number-comparison.lsp index 11dea97d..34ab181e 100644 --- a/ansi-tests/number-comparison.lsp +++ b/ansi-tests/number-comparison.lsp @@ -383,6 +383,9 @@ most-negative-double-float most-negative-long-float) 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) (rational x) (rational bound)) @@ -408,9 +411,15 @@ most-positive-double-float most-positive-long-float) 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) (rational x) (rational upper-bound)) +;; do (print x) +;; (print epsilon) (print bound) (print upper-bound) (print one) (terpri) +;; (finish-output) nconc (let* ((y (float x one)) (z (* y (- one (* 2 epsilon))))) @@ -432,6 +441,9 @@ most-positive-double-float most-positive-long-float) 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) (rational x) (rational upper-bound)) @@ -584,6 +596,9 @@ most-negative-double-float most-negative-long-float) 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) (rational x) (rational bound)) @@ -608,6 +623,9 @@ most-positive-double-float most-positive-long-float) 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) (rational x) (rational upper-bound)) @@ -632,6 +650,9 @@ most-positive-double-float most-positive-long-float) 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) (rational x) (rational upper-bound)) diff --git a/ansi-tests/numbers-aux.lsp b/ansi-tests/numbers-aux.lsp index 0a764315..dbac895d 100644 --- a/ansi-tests/numbers-aux.lsp +++ b/ansi-tests/numbers-aux.lsp @@ -19,6 +19,52 @@ (eqlt (abs x) (abs 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) (cond ((complexp x) @@ -33,21 +79,21 @@ (not (floatp y)) (etypecase y (short-float - (<= #.(rational most-negative-short-float) + (<= +rational-most-negative-short-float+ x - #.(rational most-positive-short-float))) + +rational-most-positive-short-float+)) (single-float - (<= #.(rational most-negative-single-float) + (<= +rational-most-negative-single-float+ x - #.(rational most-positive-single-float))) + +rational-most-positive-single-float+)) (double-float - (<= #.(rational most-negative-double-float) + (<= +rational-most-negative-double-float+ x - #.(rational most-positive-double-float))) + +rational-most-positive-double-float+)) (long-float - (<= #.(rational most-negative-long-float) + (<= +rational-most-negative-long-float+ x - #.(rational most-positive-long-float)))))))) + +rational-most-positive-long-float+))))))) ;;; 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 -- GitLab