source: branches/streams/abcl/src/org/armedbear/lisp/DoubleFloat.java

Last change on this file was 14757, checked in by Mark Evenson, 10 years ago

Futher fix for EQUALP on numeric tower

This fixes the following case

(let ((h1 (make-hash-table :test 'equalp))

(h2 (make-hash-table :test 'equalp))
(h (make-hash-table :test 'equalp)))

(setf (gethash 1 h1) 2

(gethash 2 h2) 1
(gethash h1 h) h2
(gethash h2 h) h1)

h)

See <​https://mailman.common-lisp.net/pipermail/armedbear-devel/2015-April/003452.html>.
See <​http://abcl.org/trac/ticket/388>.

Thanks to Massimiliano Ghilardi.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 21.4 KB
Line 
1/*
2 * DoubleFloat.java
3 *
4 * Copyright (C) 2003-2007 Peter Graves
5 * $Id: DoubleFloat.java 14757 2015-04-11 07:44:42Z mevenson $
6 *
7 * This program is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with this program; if not, write to the Free Software
19 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
20 *
21 * As a special exception, the copyright holders of this library give you
22 * permission to link this library with independent modules to produce an
23 * executable, regardless of the license terms of these independent
24 * modules, and to copy and distribute the resulting executable under
25 * terms of your choice, provided that you also meet, for each linked
26 * independent module, the terms and conditions of the license of that
27 * module.  An independent module is a module which is not derived from
28 * or based on this library.  If you modify this library, you may extend
29 * this exception to your version of the library, but you are not
30 * obligated to do so.  If you do not wish to do so, delete this
31 * exception statement from your version.
32 */
33
34package org.armedbear.lisp;
35
36import static org.armedbear.lisp.Lisp.*;
37
38import java.math.BigInteger;
39
40public final class DoubleFloat extends LispObject
41{
42    public static final DoubleFloat ZERO       = new DoubleFloat(0);
43    public static final DoubleFloat MINUS_ZERO = new DoubleFloat(-0.0d);
44    public static final DoubleFloat ONE        = new DoubleFloat(1);
45    public static final DoubleFloat MINUS_ONE  = new DoubleFloat(-1);
46
47    public static final DoubleFloat DOUBLE_FLOAT_POSITIVE_INFINITY =
48        new DoubleFloat(Double.POSITIVE_INFINITY);
49
50    public static final DoubleFloat DOUBLE_FLOAT_NEGATIVE_INFINITY =
51        new DoubleFloat(Double.NEGATIVE_INFINITY);
52
53    static {
54        Symbol.DOUBLE_FLOAT_POSITIVE_INFINITY.initializeConstant(DOUBLE_FLOAT_POSITIVE_INFINITY);
55        Symbol.DOUBLE_FLOAT_NEGATIVE_INFINITY.initializeConstant(DOUBLE_FLOAT_NEGATIVE_INFINITY);
56    }
57
58    public static DoubleFloat getInstance(double d) {
59        if (d == 0) {
60            long bits = Double.doubleToRawLongBits(d);
61            if (bits < 0)
62                return MINUS_ZERO;
63            else
64                return ZERO;
65        }
66        else if (d == 1)
67            return ONE;
68        else if (d == -1)
69            return MINUS_ONE;
70        else
71            return new DoubleFloat(d);
72    }
73
74    public final double value;
75
76    public DoubleFloat(double value)
77    {
78        this.value = value;
79    }
80
81    @Override
82    public LispObject typeOf()
83    {
84        return Symbol.DOUBLE_FLOAT;
85    }
86
87    @Override
88    public LispObject classOf()
89    {
90        return BuiltInClass.DOUBLE_FLOAT;
91    }
92
93    @Override
94    public LispObject typep(LispObject typeSpecifier)
95    {
96        if (typeSpecifier == Symbol.FLOAT)
97            return T;
98        if (typeSpecifier == Symbol.REAL)
99            return T;
100        if (typeSpecifier == Symbol.NUMBER)
101            return T;
102        if (typeSpecifier == Symbol.DOUBLE_FLOAT)
103            return T;
104        if (typeSpecifier == Symbol.LONG_FLOAT)
105            return T;
106        if (typeSpecifier == BuiltInClass.FLOAT)
107            return T;
108        if (typeSpecifier == BuiltInClass.DOUBLE_FLOAT)
109            return T;
110        return super.typep(typeSpecifier);
111    }
112
113    @Override
114    public boolean numberp()
115    {
116        return true;
117    }
118
119    @Override
120    public boolean realp()
121    {
122        return true;
123    }
124
125    @Override
126    public boolean eql(LispObject obj)
127    {
128        if (this == obj)
129            return true;
130        if (obj instanceof DoubleFloat) {
131            if (value == 0) {
132                // "If an implementation supports positive and negative zeros
133                // as distinct values, then (EQL 0.0 -0.0) returns false."
134                double d = ((DoubleFloat)obj).value;
135                long bits = Double.doubleToRawLongBits(d);
136                return bits == Double.doubleToRawLongBits(value);
137            }
138            if (value == ((DoubleFloat)obj).value)
139                return true;
140        }
141        return false;
142    }
143
144    @Override
145    public boolean equal(LispObject obj)
146    {
147        if (this == obj)
148            return true;
149        if (obj instanceof DoubleFloat) {
150            if (value == 0) {
151                // same as EQL
152                double d = ((DoubleFloat)obj).value;
153                long bits = Double.doubleToRawLongBits(d);
154                return bits == Double.doubleToRawLongBits(value);
155            }
156            if (value == ((DoubleFloat)obj).value)
157                return true;
158        }
159        return false;
160    }
161
162    @Override
163    public boolean equalp(int n)
164    {
165        // "If two numbers are the same under =."
166        return value == n;
167    }
168
169    @Override
170    public boolean equalp(LispObject obj)
171    {
172        if (obj != null && obj.numberp())
173            return isEqualTo(obj);
174        return false;
175    }
176
177    @Override
178    public LispObject ABS()
179    {
180        if (value > 0)
181            return this;
182        if (value == 0) // 0.0 or -0.0
183            return ZERO;
184        return new DoubleFloat(- value);
185    }
186
187    @Override
188    public boolean plusp()
189    {
190        return value > 0;
191    }
192
193    @Override
194    public boolean minusp()
195    {
196        return value < 0;
197    }
198
199    @Override
200    public boolean zerop()
201    {
202        return value == 0;
203    }
204
205    @Override
206    public boolean floatp()
207    {
208        return true;
209    }
210
211    public static double getValue(LispObject obj)
212    {
213        if (obj instanceof DoubleFloat) 
214            return ((DoubleFloat)obj).value;
215            type_error(obj, Symbol.FLOAT);
216            // Not reached.
217            return 0;
218    }
219
220    public final double getValue()
221    {
222        return value;
223    }
224
225    @Override
226    public double doubleValue() {
227        return value;
228    }
229
230    @Override
231    public Object javaInstance()
232    {
233        return Double.valueOf(value);
234    }
235
236    @Override
237    public Object javaInstance(Class c)
238    {
239        String cn = c.getName();
240        if (cn.equals("java.lang.Float") || cn.equals("float"))
241            return Float.valueOf((float)value);
242        return javaInstance();
243    }
244
245    @Override
246    public final LispObject incr()
247    {
248        return new DoubleFloat(value + 1);
249    }
250
251    @Override
252    public final LispObject decr()
253    {
254        return new DoubleFloat(value - 1);
255    }
256
257    @Override
258    public LispObject negate()
259    {
260        if (value == 0) {
261            long bits = Double.doubleToRawLongBits(value);
262            return (bits < 0) ? ZERO : MINUS_ZERO;
263        }
264        return new DoubleFloat(-value);
265    }
266
267    @Override
268    public LispObject add(LispObject obj)
269    {
270        if (obj instanceof Fixnum)
271            return new DoubleFloat(value + ((Fixnum)obj).value);
272        if (obj instanceof SingleFloat)
273            return new DoubleFloat(value + ((SingleFloat)obj).value);
274        if (obj instanceof DoubleFloat)
275            return new DoubleFloat(value + ((DoubleFloat)obj).value);
276        if (obj instanceof Bignum)
277            return new DoubleFloat(value + ((Bignum)obj).doubleValue());
278        if (obj instanceof Ratio)
279            return new DoubleFloat(value + ((Ratio)obj).doubleValue());
280        if (obj instanceof Complex) {
281            Complex c = (Complex) obj;
282            return Complex.getInstance(add(c.getRealPart()), c.getImaginaryPart());
283        }
284        return type_error(obj, Symbol.NUMBER);
285    }
286
287    @Override
288    public LispObject subtract(LispObject obj)
289    {
290        if (obj instanceof Fixnum)
291            return new DoubleFloat(value - ((Fixnum)obj).value);
292        if (obj instanceof SingleFloat)
293            return new DoubleFloat(value - ((SingleFloat)obj).value);
294        if (obj instanceof DoubleFloat)
295            return new DoubleFloat(value - ((DoubleFloat)obj).value);
296        if (obj instanceof Bignum)
297            return new DoubleFloat(value - ((Bignum)obj).doubleValue());
298        if (obj instanceof Ratio)
299            return new DoubleFloat(value - ((Ratio)obj).doubleValue());
300        if (obj instanceof Complex) {
301            Complex c = (Complex) obj;
302            return Complex.getInstance(subtract(c.getRealPart()),
303                                       ZERO.subtract(c.getImaginaryPart()));
304        }
305        return type_error(obj, Symbol.NUMBER);
306    }
307
308    @Override
309    public LispObject multiplyBy(LispObject obj)
310    {
311        if (obj instanceof Fixnum)
312            return new DoubleFloat(value * ((Fixnum)obj).value);
313        if (obj instanceof SingleFloat)
314            return new DoubleFloat(value * ((SingleFloat)obj).value);
315        if (obj instanceof DoubleFloat)
316            return new DoubleFloat(value * ((DoubleFloat)obj).value);
317        if (obj instanceof Bignum)
318            return new DoubleFloat(value * ((Bignum)obj).doubleValue());
319        if (obj instanceof Ratio)
320            return new DoubleFloat(value * ((Ratio)obj).doubleValue());
321        if (obj instanceof Complex) {
322            Complex c = (Complex) obj;
323            return Complex.getInstance(multiplyBy(c.getRealPart()),
324                                       multiplyBy(c.getImaginaryPart()));
325        }
326        return type_error(obj, Symbol.NUMBER);
327    }
328
329    @Override
330    public LispObject divideBy(LispObject obj)
331    {
332        if (obj instanceof Fixnum)
333            return new DoubleFloat(value / ((Fixnum)obj).value);
334        if (obj instanceof SingleFloat)
335            return new DoubleFloat(value / ((SingleFloat)obj).value);
336        if (obj instanceof DoubleFloat)
337            return new DoubleFloat(value / ((DoubleFloat)obj).value);
338        if (obj instanceof Bignum)
339            return new DoubleFloat(value / ((Bignum)obj).doubleValue());
340        if (obj instanceof Ratio)
341            return new DoubleFloat(value / ((Ratio)obj).doubleValue());
342        if (obj instanceof Complex) {
343            Complex c = (Complex) obj;
344            LispObject re = c.getRealPart();
345            LispObject im = c.getImaginaryPart();
346            LispObject denom = re.multiplyBy(re).add(im.multiplyBy(im));
347            LispObject resX = multiplyBy(re).divideBy(denom);
348            LispObject resY =
349                multiplyBy(Fixnum.MINUS_ONE).multiplyBy(im).divideBy(denom);
350            return Complex.getInstance(resX, resY);
351        }
352        return type_error(obj, Symbol.NUMBER);
353    }
354
355    @Override
356    public boolean isEqualTo(LispObject obj)
357    {
358        if (obj instanceof Fixnum)
359            return value == ((Fixnum)obj).value;
360        if (obj instanceof SingleFloat)
361            return value == ((SingleFloat)obj).value;
362        if (obj instanceof DoubleFloat)
363            return value == ((DoubleFloat)obj).value;
364        if (obj instanceof Bignum)
365            return rational().isEqualTo(obj);
366        if (obj instanceof Ratio)
367            return rational().isEqualTo(obj);
368        if (obj instanceof Complex)
369            return obj.isEqualTo(this);
370        type_error(obj, Symbol.NUMBER);
371        // Not reached.
372        return false;
373    }
374
375    @Override
376    public boolean isNotEqualTo(LispObject obj)
377    {
378        return !isEqualTo(obj);
379    }
380
381    @Override
382    public boolean isLessThan(LispObject obj)
383    {
384        if (obj instanceof Fixnum)
385            return value < ((Fixnum)obj).value;
386        if (obj instanceof SingleFloat)
387            return value < ((SingleFloat)obj).value;
388        if (obj instanceof DoubleFloat)
389            return value < ((DoubleFloat)obj).value;
390        if (obj instanceof Bignum)
391            return rational().isLessThan(obj);
392        if (obj instanceof Ratio)
393            return rational().isLessThan(obj);
394        type_error(obj, Symbol.REAL);
395        // Not reached.
396        return false;
397    }
398
399    @Override
400    public boolean isGreaterThan(LispObject obj)
401    {
402        if (obj instanceof Fixnum)
403            return value > ((Fixnum)obj).value;
404        if (obj instanceof SingleFloat)
405            return value > ((SingleFloat)obj).value;
406        if (obj instanceof DoubleFloat)
407            return value > ((DoubleFloat)obj).value;
408        if (obj instanceof Bignum)
409            return rational().isGreaterThan(obj);
410        if (obj instanceof Ratio)
411            return rational().isGreaterThan(obj);
412        type_error(obj, Symbol.REAL);
413        // Not reached.
414        return false;
415    }
416
417    @Override
418    public boolean isLessThanOrEqualTo(LispObject obj)
419    {
420        if (obj instanceof Fixnum)
421            return value <= ((Fixnum)obj).value;
422        if (obj instanceof SingleFloat)
423            return value <= ((SingleFloat)obj).value;
424        if (obj instanceof DoubleFloat)
425            return value <= ((DoubleFloat)obj).value;
426        if (obj instanceof Bignum)
427            return rational().isLessThanOrEqualTo(obj);
428        if (obj instanceof Ratio)
429            return rational().isLessThanOrEqualTo(obj);
430        type_error(obj, Symbol.REAL);
431        // Not reached.
432        return false;
433    }
434
435    @Override
436    public boolean isGreaterThanOrEqualTo(LispObject obj)
437    {
438        if (obj instanceof Fixnum)
439            return value >= ((Fixnum)obj).value;
440        if (obj instanceof SingleFloat)
441            return value >= ((SingleFloat)obj).value;
442        if (obj instanceof DoubleFloat)
443            return value >= ((DoubleFloat)obj).value;
444        if (obj instanceof Bignum)
445            return rational().isGreaterThanOrEqualTo(obj);
446        if (obj instanceof Ratio)
447            return rational().isGreaterThanOrEqualTo(obj);
448        type_error(obj, Symbol.REAL);
449        // Not reached.
450        return false;
451    }
452
453    @Override
454    public LispObject truncate(LispObject obj)
455    {
456        // "When rationals and floats are combined by a numerical function,
457        // the rational is first converted to a float of the same format."
458        // 12.1.4.1
459        if (obj instanceof Fixnum) {
460            return truncate(new DoubleFloat(((Fixnum)obj).value));
461        }
462        if (obj instanceof Bignum) {
463            return truncate(new DoubleFloat(((Bignum)obj).doubleValue()));
464        }
465        if (obj instanceof Ratio) {
466            return truncate(new DoubleFloat(((Ratio)obj).doubleValue()));
467        }
468        if (obj instanceof SingleFloat) {
469            final LispThread thread = LispThread.currentThread();
470            double divisor = ((SingleFloat)obj).value;
471            double quotient = value / divisor;
472            if (value != 0)
473                MathFunctions.OverUnderFlowCheck(quotient);
474            if (quotient >= Integer.MIN_VALUE && quotient <= Integer.MAX_VALUE) {
475                int q = (int) quotient;
476                return thread.setValues(Fixnum.getInstance(q),
477                                        new DoubleFloat(value - q * divisor));
478            }
479            // We need to convert the quotient to a bignum.
480            long bits = Double.doubleToRawLongBits((double)quotient);
481            int s = ((bits >> 63) == 0) ? 1 : -1;
482            int e = (int) ((bits >> 52) & 0x7ffL);
483            long m;
484            if (e == 0)
485                m = (bits & 0xfffffffffffffL) << 1;
486            else
487                m = (bits & 0xfffffffffffffL) | 0x10000000000000L;
488            LispObject significand = number(m);
489            Fixnum exponent = Fixnum.getInstance(e - 1075);
490            Fixnum sign = Fixnum.getInstance(s);
491            LispObject result = significand;
492            result =
493                result.multiplyBy(MathFunctions.EXPT.execute(Fixnum.TWO, exponent));
494            result = result.multiplyBy(sign);
495            // Calculate remainder.
496            LispObject product = result.multiplyBy(obj);
497            LispObject remainder = subtract(product);
498            return thread.setValues(result, remainder);
499        }
500        if (obj instanceof DoubleFloat) {
501//             Debug.trace("value = " + value);
502            final LispThread thread = LispThread.currentThread();
503            double divisor = ((DoubleFloat)obj).value;
504//             Debug.trace("divisor = " + divisor);
505            double quotient = value / divisor;
506            if (value != 0)
507                MathFunctions.OverUnderFlowCheck(quotient);
508//             Debug.trace("quotient = " + quotient);
509            if (quotient >= Integer.MIN_VALUE && quotient <= Integer.MAX_VALUE) {
510                int q = (int) quotient;
511                return thread.setValues(Fixnum.getInstance(q),
512                                        new DoubleFloat(value - q * divisor));
513            }
514            // We need to convert the quotient to a bignum.
515            long bits = Double.doubleToRawLongBits((double)quotient);
516            int s = ((bits >> 63) == 0) ? 1 : -1;
517            int e = (int) ((bits >> 52) & 0x7ffL);
518            long m;
519            if (e == 0)
520                m = (bits & 0xfffffffffffffL) << 1;
521            else
522                m = (bits & 0xfffffffffffffL) | 0x10000000000000L;
523            LispObject significand = number(m);
524//             Debug.trace("significand = " + significand.printObject());
525            Fixnum exponent = Fixnum.getInstance(e - 1075);
526//             Debug.trace("exponent = " + exponent.printObject());
527            Fixnum sign = Fixnum.getInstance(s);
528//             Debug.trace("sign = " + sign.printObject());
529            LispObject result = significand;
530//             Debug.trace("result = " + result.printObject());
531            result =
532                result.multiplyBy(MathFunctions.EXPT.execute(Fixnum.TWO, exponent));
533//             Debug.trace("result = " + result.printObject());
534
535
536            result = result.truncate(Fixnum.ONE);
537            LispObject remainder = coerceToFloat(thread._values[1]);
538
539            result = result.multiplyBy(sign);
540//             Debug.trace("result = " + result.printObject());
541//             // Calculate remainder.
542//             LispObject product = result.multiplyBy(obj);
543//             Debug.trace("product = " + product.printObject());
544//             LispObject remainder = subtract(product);
545            return thread.setValues(result, remainder);
546        }
547        return type_error(obj, Symbol.REAL);
548    }
549
550    @Override
551    public int hashCode()
552    {
553        long bits = Double.doubleToLongBits(value);
554        return (int) (bits ^ (bits >>> 32));
555    }
556
557    @Override
558    public int psxhash()
559    {
560        if ((value % 1) == 0)
561            return (((int)value) & 0x7fffffff);
562        else
563            return (hashCode() & 0x7fffffff);
564    }
565
566    @Override
567    public String printObject()
568    {
569        if (value == Double.POSITIVE_INFINITY) {
570            StringBuilder sb = new StringBuilder("#.");
571            sb.append(Symbol.DOUBLE_FLOAT_POSITIVE_INFINITY.printObject());
572            return sb.toString();
573        }
574        if (value == Double.NEGATIVE_INFINITY) {
575            StringBuilder sb = new StringBuilder("#.");
576            sb.append(Symbol.DOUBLE_FLOAT_NEGATIVE_INFINITY.printObject());
577            return sb.toString();
578        }
579
580        LispThread thread = LispThread.currentThread();
581        boolean printReadably = Symbol.PRINT_READABLY.symbolValue(thread) != NIL;
582
583        if (value != value) {
584            if (printReadably)
585                return "#.(CL:PROGN \"Comment: create a NaN.\" (CL:/ 0.0d0 0.0d0))";
586            else
587                return unreadableString("DOUBLE-FLOAT NaN", false);
588        }
589        String s1 = String.valueOf(value);
590        if (printReadably ||
591            !memq(Symbol.READ_DEFAULT_FLOAT_FORMAT.symbolValue(thread),
592                  list(Symbol.DOUBLE_FLOAT, Symbol.LONG_FLOAT)))
593        {
594            if (s1.indexOf('E') >= 0)
595                return s1.replace('E', 'd');
596            else
597                return s1.concat("d0");
598        } else
599            return s1;
600    }
601
602    public LispObject rational()
603    {
604        final long bits = Double.doubleToRawLongBits(value);
605        int sign = ((bits >> 63) == 0) ? 1 : -1;
606        int storedExponent = (int) ((bits >> 52) & 0x7ffL);
607        long mantissa;
608        if (storedExponent == 0)
609            mantissa = (bits & 0xfffffffffffffL) << 1;
610        else
611            mantissa = (bits & 0xfffffffffffffL) | 0x10000000000000L;
612        if (mantissa == 0)
613            return Fixnum.ZERO;
614        if (sign < 0)
615            mantissa = -mantissa;
616        // Subtract bias.
617        final int exponent = storedExponent - 1023;
618        BigInteger numerator, denominator;
619        if (exponent < 0) {
620            numerator = BigInteger.valueOf(mantissa);
621            denominator = BigInteger.valueOf(1).shiftLeft(52 - exponent);
622        } else {
623            numerator = BigInteger.valueOf(mantissa).shiftLeft(exponent);
624            denominator = BigInteger.valueOf(0x10000000000000L); // (ash 1 52)
625        }
626        return number(numerator, denominator);
627    }
628
629    public static DoubleFloat coerceToFloat(LispObject obj)
630    {
631        if (obj instanceof DoubleFloat)
632            return (DoubleFloat) obj;
633        if (obj instanceof Fixnum)
634            return new DoubleFloat(((Fixnum)obj).value);
635        if (obj instanceof Bignum)
636            return new DoubleFloat(((Bignum)obj).doubleValue());
637        if (obj instanceof SingleFloat)
638            return new DoubleFloat(((SingleFloat)obj).value);
639        if (obj instanceof Ratio)
640            return new DoubleFloat(((Ratio)obj).doubleValue());
641        error(new TypeError("The value " + obj.princToString() +
642                             " cannot be converted to type DOUBLE-FLOAT."));
643        // Not reached.
644        return null;
645    }
646}
Note: See TracBrowser for help on using the repository browser.