Changeset 15292


Ignore:
Timestamp:
06/01/20 13:56:48 (6 months ago)
Author:
Mark Evenson
Message:

Further fixes for floating point values

DECODE-FLOAT now returns a significand in the interval between 1/2
(inclusive) and 1 (exclusive) as implied by ANSI.

Coercion of values smaller than 2-1023 to double floats no longer
returns zero.

Completed addressing the issues raised by Robert Dodier in
<https://github.com/armedbear/abcl/issues/93>,
<https://github.com/armedbear/abcl/issues/94>, and
<https://github.com/armedbear/abcl/issues/95>.

Location:
trunk/abcl
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/FloatFunctions.java

    r14465 r15292  
    9696        new Primitive("integer-decode-float", "float")
    9797    {
    98 //         (defun sane-integer-decode-float (float)
    99 //           (multiple-value-bind (mantissa exp sign)
    100 //               (integer-decode-float float)
    101 //             (let ((fixup (- (integer-length mantissa) (float-precision float))))
    102 //                   (values (ash mantissa (- fixup))
    103 //                           (+ exp fixup)
    104 //                           sign))))
    105 
    106         // See also: http://paste.lisp.org/display/10847
    107 
    10898        @Override
    10999        public LispObject execute(LispObject arg)
    110100        {
    111101            if (arg instanceof SingleFloat) {
     102                if (arg.equals(SingleFloat.SINGLE_FLOAT_POSITIVE_INFINITY)
     103                    || arg.equals(SingleFloat.SINGLE_FLOAT_NEGATIVE_INFINITY)) {
     104                    return error(new LispError("Cannot decode infinity."));
     105                }
    112106                int bits =
    113107                    Float.floatToRawIntBits(((SingleFloat)arg).value);
     
    127121            }
    128122            if (arg instanceof DoubleFloat) {
     123                if (arg.equals(DoubleFloat.DOUBLE_FLOAT_POSITIVE_INFINITY)
     124                    || arg.equals(DoubleFloat.DOUBLE_FLOAT_NEGATIVE_INFINITY)) {
     125                    return error(new LispError("Cannot decode infinity."));
     126                }
     127
    129128                long bits =
    130129                    Double.doubleToRawLongBits((double)((DoubleFloat)arg).value);
  • trunk/abcl/src/org/armedbear/lisp/Ratio.java

    r14757 r15292  
    3737
    3838import java.math.BigInteger;
     39import java.math.BigDecimal;
     40import java.math.MathContext;
     41import java.math.RoundingMode;
    3942
    4043public final class Ratio extends LispObject
     
    193196        final int denLen = den.bitLength();
    194197        int length = Math.min(numLen, denLen);
    195         if (length <= 1)
    196             return result;
     198        if (length <= 1) { 
     199          // A precision of 512 is overkill for DOUBLE-FLOAT types
     200          // based on java.lang.Double  TODO: optimize for space/time
     201          final MathContext mathContext = new MathContext(512, RoundingMode.HALF_EVEN);
     202          BigDecimal p = new BigDecimal(numerator, mathContext);
     203          BigDecimal q = new BigDecimal(denominator, mathContext);
     204          BigDecimal r = p.divide(q, mathContext);
     205          result = r.doubleValue();
     206          return result;
     207        }
     208
    197209        BigInteger n = num;
    198210        BigInteger d = den;
  • trunk/abcl/src/org/armedbear/lisp/numbers.lisp

    r15226 r15292  
    164164             :format-arguments (list float)))))
    165165
     166;;; From <http://paste.lisp.org/display/10847>.  Thanks Xophe!
     167(defun sane-integer-decode-float (float)
     168  (multiple-value-bind (mantissa exp sign)
     169      (integer-decode-float float)
     170    (let ((fixup (- (integer-length mantissa) (float-precision float))))
     171      (values (ash mantissa (- fixup))
     172              (+ exp fixup)
     173              sign))))
     174
    166175(defun decode-float-single (float)
    167176  ;; TODO memoize
    168177  (let ((float-precision-single (float-precision 1f0)))
    169178    (multiple-value-bind (significand exponent sign)
    170         (integer-decode-float float)
     179        (sane-integer-decode-float float)
    171180      (values (coerce (/ significand (expt 2 float-precision-single)) 'single-float)
    172181              (+ exponent float-precision-single)
     
    178187  (let ((float-precision-double (float-precision 1d0)))
    179188    (multiple-value-bind (significand exponent sign)
    180         (integer-decode-float float)
     189        (sane-integer-decode-float float)
    181190      (values (coerce (/ significand (expt 2 float-precision-double)) 'double-float)
    182191              (+ exponent float-precision-double)
  • trunk/abcl/t/decode-float.lisp

    r15249 r15292  
    4444      (prove:is-type result 'double-float))))
    4545
    46 ;;; additional things along the way

     46;; From the REPL, I don't get a signaled condition, but these tests succeed

     47(let ((infinities '(single-float-positive-infinity
     48                    single-float-negative-infinity
     49                    double-float-positive-infinity
     50                    double-float-negative-infinity)))
     51  (prove:plan (length infinities))
     52  (dolist (infinity infinities)
     53    (prove:is-error
     54     (decode-float infinity)
     55     'error
     56     (format nil "Attempting to DECODE-FLOAT ~a should signal error" infinity))))
    4757
    48 #|
    49 Should fail, as you shouldn't be able to
    50 (decode-float single-float-positive-infinity)
    51 |#
     58
     59(let ((floats `(1f0
     60                1d0
     61                1f6
     62                1d6
     63                1f-6
     64                1d-6
     65                ,least-positive-normalized-single-float
     66                ,least-positive-single-float
     67                ,least-positive-normalized-double-float
     68                ,least-positive-double-float)))
     69  (prove:plan (length floats))
     70  (dolist (float floats)
     71    (multiple-value-bind (significand exponent sign)
     72        (integer-decode-float float)
     73      (prove:is
     74       (coerce (* significand (expt 2 exponent)) (type-of float))
     75       float
     76       (format nil "INTEGER-DECODE-FLOAT roundtrips for ~s" float)))))
     77
    5278
    5379(prove:finalize)
Note: See TracChangeset for help on using the changeset viewer.