changing floating point number input.. (was realroots...)

Richard,

Here's an attempt at a implementation-neutral modification
of nformat to print nan's and inf's. Here's a sample session
(after loading the code) using GCL:

(%i1) obase : 16.;
(%o1)                          10
(%i2) a : ?most\-positive\-short\-float;
(%o2)                     3.4028235S+38
(%i3) 2 * a;
(%o3)               float_inf(1, 69, 800000)
(%i4) -2 * a;
(%o4)              float_inf(- 1, 69, 800000)
(%i5) 2 * a - 3 * a;
(%o5)              float_nan(- 1, 69, C00000)
(%i6) b : ?most\-positive\-double\-float;
(%o6)                1.7976931348623157E+308
(%i7) 2 * b;
(%o7)           float_inf(1, 3CC, 10000000000000)
(%i8) -2 * b;
(%o8)          float_inf(- 1, 3CC, 10000000000000)
(%i9) 2 * b - 3 * b;
(%o9)          float_nan(- 1, 3CC, 18000000000000)

Printing the sign, exponent, and significand makes the
result theoretically readable ....

FWIW
Robert

PS. Here's the code. Doubtless this can be improved.

(defun significand-bits (x) (nth-value 0 (integer-decode-float x)))

(defun exponent-bits (x) (nth-value 1 (integer-decode-float x)))

(defun float-special-value-p (x)
  (and (floatp x)
    (let
      ((max-exponent
         (typecase x
           (short-float (exponent-bits most-positive-short-float))
           (single-float (exponent-bits most-positive-single-float))
           (double-float (exponent-bits most-positive-double-float))
           (long-float (exponent-bits most-positive-long-float)))))
        (= (exponent-bits x) (1+ max-exponent)))))

(defun float-inf-p (x)
  (and
    (float-special-value-p x)
    (= (significand-bits x) (lsh 1 (1- (float-digits x))))))

(defun float-nan-p (x)
  (and
    (float-special-value-p x)
    (not (= (significand-bits x) (lsh 1 (1- (float-digits x)))))))

(let ((save-nformat #'nformat))
  (defun nformat (x)
    (cond
      ((float-inf-p x)
       (apply save-nformat (list `(($float_inf) ,@(reverse
(multiple-value-list (integer-decode-float x)))))))
      ((float-nan-p x)
       (apply save-nformat (list `(($float_nan) ,@(reverse
(multiple-value-list (integer-decode-float x)))))))
      (t
        (apply save-nformat (list x))))))