source: branches/1.1.x/src/org/armedbear/lisp/DoubleFloat.java

Last change on this file was 14062, checked in by rschlatte, 12 years ago

Robustify readably-printed NaNs? in the spirit of #14061
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 21.8 KB
Line 
1/*
2 * DoubleFloat.java
3 *
4 * Copyright (C) 2003-2007 Peter Graves
5 * $Id: DoubleFloat.java 14062 2012-08-06 19:02:32Z rschlatte $
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 instanceof SingleFloat)
173            return value == ((SingleFloat)obj).value;
174        if (obj instanceof DoubleFloat)
175            return value == ((DoubleFloat)obj).value;
176        if (obj instanceof Fixnum)
177            return value == ((Fixnum)obj).value;
178        if (obj instanceof Bignum)
179            return value == ((Bignum)obj).doubleValue();
180        if (obj instanceof Ratio)
181            return value == ((Ratio)obj).doubleValue();
182        return false;
183    }
184
185    @Override
186    public LispObject ABS()
187    {
188        if (value > 0)
189            return this;
190        if (value == 0) // 0.0 or -0.0
191            return ZERO;
192        return new DoubleFloat(- value);
193    }
194
195    @Override
196    public boolean plusp()
197    {
198        return value > 0;
199    }
200
201    @Override
202    public boolean minusp()
203    {
204        return value < 0;
205    }
206
207    @Override
208    public boolean zerop()
209    {
210        return value == 0;
211    }
212
213    @Override
214    public boolean floatp()
215    {
216        return true;
217    }
218
219    public static double getValue(LispObject obj)
220    {
221        if (obj instanceof DoubleFloat) 
222            return ((DoubleFloat)obj).value;
223            type_error(obj, Symbol.FLOAT);
224            // Not reached.
225            return 0;
226    }
227
228    public final double getValue()
229    {
230        return value;
231    }
232
233    @Override
234    public double doubleValue() {
235        return value;
236    }
237
238    @Override
239    public Object javaInstance()
240    {
241        return Double.valueOf(value);
242    }
243
244    @Override
245    public Object javaInstance(Class c)
246    {
247        String cn = c.getName();
248        if (cn.equals("java.lang.Float") || cn.equals("float"))
249            return Float.valueOf((float)value);
250        return javaInstance();
251    }
252
253    @Override
254    public final LispObject incr()
255    {
256        return new DoubleFloat(value + 1);
257    }
258
259    @Override
260    public final LispObject decr()
261    {
262        return new DoubleFloat(value - 1);
263    }
264
265    @Override
266    public LispObject negate()
267    {
268        if (value == 0) {
269            long bits = Double.doubleToRawLongBits(value);
270            return (bits < 0) ? ZERO : MINUS_ZERO;
271        }
272        return new DoubleFloat(-value);
273    }
274
275    @Override
276    public LispObject add(LispObject obj)
277    {
278        if (obj instanceof Fixnum)
279            return new DoubleFloat(value + ((Fixnum)obj).value);
280        if (obj instanceof SingleFloat)
281            return new DoubleFloat(value + ((SingleFloat)obj).value);
282        if (obj instanceof DoubleFloat)
283            return new DoubleFloat(value + ((DoubleFloat)obj).value);
284        if (obj instanceof Bignum)
285            return new DoubleFloat(value + ((Bignum)obj).doubleValue());
286        if (obj instanceof Ratio)
287            return new DoubleFloat(value + ((Ratio)obj).doubleValue());
288        if (obj instanceof Complex) {
289            Complex c = (Complex) obj;
290            return Complex.getInstance(add(c.getRealPart()), c.getImaginaryPart());
291        }
292        return type_error(obj, Symbol.NUMBER);
293    }
294
295    @Override
296    public LispObject subtract(LispObject obj)
297    {
298        if (obj instanceof Fixnum)
299            return new DoubleFloat(value - ((Fixnum)obj).value);
300        if (obj instanceof SingleFloat)
301            return new DoubleFloat(value - ((SingleFloat)obj).value);
302        if (obj instanceof DoubleFloat)
303            return new DoubleFloat(value - ((DoubleFloat)obj).value);
304        if (obj instanceof Bignum)
305            return new DoubleFloat(value - ((Bignum)obj).doubleValue());
306        if (obj instanceof Ratio)
307            return new DoubleFloat(value - ((Ratio)obj).doubleValue());
308        if (obj instanceof Complex) {
309            Complex c = (Complex) obj;
310            return Complex.getInstance(subtract(c.getRealPart()),
311                                       ZERO.subtract(c.getImaginaryPart()));
312        }
313        return type_error(obj, Symbol.NUMBER);
314    }
315
316    @Override
317    public LispObject multiplyBy(LispObject obj)
318    {
319        if (obj instanceof Fixnum)
320            return new DoubleFloat(value * ((Fixnum)obj).value);
321        if (obj instanceof SingleFloat)
322            return new DoubleFloat(value * ((SingleFloat)obj).value);
323        if (obj instanceof DoubleFloat)
324            return new DoubleFloat(value * ((DoubleFloat)obj).value);
325        if (obj instanceof Bignum)
326            return new DoubleFloat(value * ((Bignum)obj).doubleValue());
327        if (obj instanceof Ratio)
328            return new DoubleFloat(value * ((Ratio)obj).doubleValue());
329        if (obj instanceof Complex) {
330            Complex c = (Complex) obj;
331            return Complex.getInstance(multiplyBy(c.getRealPart()),
332                                       multiplyBy(c.getImaginaryPart()));
333        }
334        return type_error(obj, Symbol.NUMBER);
335    }
336
337    @Override
338    public LispObject divideBy(LispObject obj)
339    {
340        if (obj instanceof Fixnum)
341            return new DoubleFloat(value / ((Fixnum)obj).value);
342        if (obj instanceof SingleFloat)
343            return new DoubleFloat(value / ((SingleFloat)obj).value);
344        if (obj instanceof DoubleFloat)
345            return new DoubleFloat(value / ((DoubleFloat)obj).value);
346        if (obj instanceof Bignum)
347            return new DoubleFloat(value / ((Bignum)obj).doubleValue());
348        if (obj instanceof Ratio)
349            return new DoubleFloat(value / ((Ratio)obj).doubleValue());
350        if (obj instanceof Complex) {
351            Complex c = (Complex) obj;
352            LispObject re = c.getRealPart();
353            LispObject im = c.getImaginaryPart();
354            LispObject denom = re.multiplyBy(re).add(im.multiplyBy(im));
355            LispObject resX = multiplyBy(re).divideBy(denom);
356            LispObject resY =
357                multiplyBy(Fixnum.MINUS_ONE).multiplyBy(im).divideBy(denom);
358            return Complex.getInstance(resX, resY);
359        }
360        return type_error(obj, Symbol.NUMBER);
361    }
362
363    @Override
364    public boolean isEqualTo(LispObject obj)
365    {
366        if (obj instanceof Fixnum)
367            return value == ((Fixnum)obj).value;
368        if (obj instanceof SingleFloat)
369            return value == ((SingleFloat)obj).value;
370        if (obj instanceof DoubleFloat)
371            return value == ((DoubleFloat)obj).value;
372        if (obj instanceof Bignum)
373            return rational().isEqualTo(obj);
374        if (obj instanceof Ratio)
375            return rational().isEqualTo(obj);
376        if (obj instanceof Complex)
377            return obj.isEqualTo(this);
378        type_error(obj, Symbol.NUMBER);
379        // Not reached.
380        return false;
381    }
382
383    @Override
384    public boolean isNotEqualTo(LispObject obj)
385    {
386        return !isEqualTo(obj);
387    }
388
389    @Override
390    public boolean isLessThan(LispObject obj)
391    {
392        if (obj instanceof Fixnum)
393            return value < ((Fixnum)obj).value;
394        if (obj instanceof SingleFloat)
395            return value < ((SingleFloat)obj).value;
396        if (obj instanceof DoubleFloat)
397            return value < ((DoubleFloat)obj).value;
398        if (obj instanceof Bignum)
399            return rational().isLessThan(obj);
400        if (obj instanceof Ratio)
401            return rational().isLessThan(obj);
402        type_error(obj, Symbol.REAL);
403        // Not reached.
404        return false;
405    }
406
407    @Override
408    public boolean isGreaterThan(LispObject obj)
409    {
410        if (obj instanceof Fixnum)
411            return value > ((Fixnum)obj).value;
412        if (obj instanceof SingleFloat)
413            return value > ((SingleFloat)obj).value;
414        if (obj instanceof DoubleFloat)
415            return value > ((DoubleFloat)obj).value;
416        if (obj instanceof Bignum)
417            return rational().isGreaterThan(obj);
418        if (obj instanceof Ratio)
419            return rational().isGreaterThan(obj);
420        type_error(obj, Symbol.REAL);
421        // Not reached.
422        return false;
423    }
424
425    @Override
426    public boolean isLessThanOrEqualTo(LispObject obj)
427    {
428        if (obj instanceof Fixnum)
429            return value <= ((Fixnum)obj).value;
430        if (obj instanceof SingleFloat)
431            return value <= ((SingleFloat)obj).value;
432        if (obj instanceof DoubleFloat)
433            return value <= ((DoubleFloat)obj).value;
434        if (obj instanceof Bignum)
435            return rational().isLessThanOrEqualTo(obj);
436        if (obj instanceof Ratio)
437            return rational().isLessThanOrEqualTo(obj);
438        type_error(obj, Symbol.REAL);
439        // Not reached.
440        return false;
441    }
442
443    @Override
444    public boolean isGreaterThanOrEqualTo(LispObject obj)
445    {
446        if (obj instanceof Fixnum)
447            return value >= ((Fixnum)obj).value;
448        if (obj instanceof SingleFloat)
449            return value >= ((SingleFloat)obj).value;
450        if (obj instanceof DoubleFloat)
451            return value >= ((DoubleFloat)obj).value;
452        if (obj instanceof Bignum)
453            return rational().isGreaterThanOrEqualTo(obj);
454        if (obj instanceof Ratio)
455            return rational().isGreaterThanOrEqualTo(obj);
456        type_error(obj, Symbol.REAL);
457        // Not reached.
458        return false;
459    }
460
461    @Override
462    public LispObject truncate(LispObject obj)
463    {
464        // "When rationals and floats are combined by a numerical function,
465        // the rational is first converted to a float of the same format."
466        // 12.1.4.1
467        if (obj instanceof Fixnum) {
468            return truncate(new DoubleFloat(((Fixnum)obj).value));
469        }
470        if (obj instanceof Bignum) {
471            return truncate(new DoubleFloat(((Bignum)obj).doubleValue()));
472        }
473        if (obj instanceof Ratio) {
474            return truncate(new DoubleFloat(((Ratio)obj).doubleValue()));
475        }
476        if (obj instanceof SingleFloat) {
477            final LispThread thread = LispThread.currentThread();
478            double divisor = ((SingleFloat)obj).value;
479            double quotient = value / divisor;
480            if (value != 0)
481                MathFunctions.OverUnderFlowCheck(quotient);
482            if (quotient >= Integer.MIN_VALUE && quotient <= Integer.MAX_VALUE) {
483                int q = (int) quotient;
484                return thread.setValues(Fixnum.getInstance(q),
485                                        new DoubleFloat(value - q * divisor));
486            }
487            // We need to convert the quotient to a bignum.
488            long bits = Double.doubleToRawLongBits((double)quotient);
489            int s = ((bits >> 63) == 0) ? 1 : -1;
490            int e = (int) ((bits >> 52) & 0x7ffL);
491            long m;
492            if (e == 0)
493                m = (bits & 0xfffffffffffffL) << 1;
494            else
495                m = (bits & 0xfffffffffffffL) | 0x10000000000000L;
496            LispObject significand = number(m);
497            Fixnum exponent = Fixnum.getInstance(e - 1075);
498            Fixnum sign = Fixnum.getInstance(s);
499            LispObject result = significand;
500            result =
501                result.multiplyBy(MathFunctions.EXPT.execute(Fixnum.TWO, exponent));
502            result = result.multiplyBy(sign);
503            // Calculate remainder.
504            LispObject product = result.multiplyBy(obj);
505            LispObject remainder = subtract(product);
506            return thread.setValues(result, remainder);
507        }
508        if (obj instanceof DoubleFloat) {
509//             Debug.trace("value = " + value);
510            final LispThread thread = LispThread.currentThread();
511            double divisor = ((DoubleFloat)obj).value;
512//             Debug.trace("divisor = " + divisor);
513            double quotient = value / divisor;
514            if (value != 0)
515                MathFunctions.OverUnderFlowCheck(quotient);
516//             Debug.trace("quotient = " + quotient);
517            if (quotient >= Integer.MIN_VALUE && quotient <= Integer.MAX_VALUE) {
518                int q = (int) quotient;
519                return thread.setValues(Fixnum.getInstance(q),
520                                        new DoubleFloat(value - q * divisor));
521            }
522            // We need to convert the quotient to a bignum.
523            long bits = Double.doubleToRawLongBits((double)quotient);
524            int s = ((bits >> 63) == 0) ? 1 : -1;
525            int e = (int) ((bits >> 52) & 0x7ffL);
526            long m;
527            if (e == 0)
528                m = (bits & 0xfffffffffffffL) << 1;
529            else
530                m = (bits & 0xfffffffffffffL) | 0x10000000000000L;
531            LispObject significand = number(m);
532//             Debug.trace("significand = " + significand.printObject());
533            Fixnum exponent = Fixnum.getInstance(e - 1075);
534//             Debug.trace("exponent = " + exponent.printObject());
535            Fixnum sign = Fixnum.getInstance(s);
536//             Debug.trace("sign = " + sign.printObject());
537            LispObject result = significand;
538//             Debug.trace("result = " + result.printObject());
539            result =
540                result.multiplyBy(MathFunctions.EXPT.execute(Fixnum.TWO, exponent));
541//             Debug.trace("result = " + result.printObject());
542
543
544            result = result.truncate(Fixnum.ONE);
545            LispObject remainder = coerceToFloat(thread._values[1]);
546
547            result = result.multiplyBy(sign);
548//             Debug.trace("result = " + result.printObject());
549//             // Calculate remainder.
550//             LispObject product = result.multiplyBy(obj);
551//             Debug.trace("product = " + product.printObject());
552//             LispObject remainder = subtract(product);
553            return thread.setValues(result, remainder);
554        }
555        return type_error(obj, Symbol.REAL);
556    }
557
558    @Override
559    public int hashCode()
560    {
561        long bits = Double.doubleToLongBits(value);
562        return (int) (bits ^ (bits >>> 32));
563    }
564
565    @Override
566    public int psxhash()
567    {
568        if ((value % 1) == 0)
569            return (((int)value) & 0x7fffffff);
570        else
571            return (hashCode() & 0x7fffffff);
572    }
573
574    @Override
575    public String printObject()
576    {
577        if (value == Double.POSITIVE_INFINITY) {
578            StringBuilder sb = new StringBuilder("#.");
579            sb.append(Symbol.DOUBLE_FLOAT_POSITIVE_INFINITY.printObject());
580            return sb.toString();
581        }
582        if (value == Double.NEGATIVE_INFINITY) {
583            StringBuilder sb = new StringBuilder("#.");
584            sb.append(Symbol.DOUBLE_FLOAT_NEGATIVE_INFINITY.printObject());
585            return sb.toString();
586        }
587
588        LispThread thread = LispThread.currentThread();
589        boolean printReadably = Symbol.PRINT_READABLY.symbolValue(thread) != NIL;
590
591        if (value != value) {
592            if (printReadably)
593                return "#.(CL:PROGN \"Comment: create a NaN.\" (CL:/ 0.0d0 0.0d0))";
594            else
595                return unreadableString("DOUBLE-FLOAT NaN", false);
596        }
597        String s1 = String.valueOf(value);
598        if (printReadably ||
599            !memq(Symbol.READ_DEFAULT_FLOAT_FORMAT.symbolValue(thread),
600                  list(Symbol.DOUBLE_FLOAT, Symbol.LONG_FLOAT)))
601        {
602            if (s1.indexOf('E') >= 0)
603                return s1.replace('E', 'd');
604            else
605                return s1.concat("d0");
606        } else
607            return s1;
608    }
609
610    public LispObject rational()
611    {
612        final long bits = Double.doubleToRawLongBits(value);
613        int sign = ((bits >> 63) == 0) ? 1 : -1;
614        int storedExponent = (int) ((bits >> 52) & 0x7ffL);
615        long mantissa;
616        if (storedExponent == 0)
617            mantissa = (bits & 0xfffffffffffffL) << 1;
618        else
619            mantissa = (bits & 0xfffffffffffffL) | 0x10000000000000L;
620        if (mantissa == 0)
621            return Fixnum.ZERO;
622        if (sign < 0)
623            mantissa = -mantissa;
624        // Subtract bias.
625        final int exponent = storedExponent - 1023;
626        BigInteger numerator, denominator;
627        if (exponent < 0) {
628            numerator = BigInteger.valueOf(mantissa);
629            denominator = BigInteger.valueOf(1).shiftLeft(52 - exponent);
630        } else {
631            numerator = BigInteger.valueOf(mantissa).shiftLeft(exponent);
632            denominator = BigInteger.valueOf(0x10000000000000L); // (ash 1 52)
633        }
634        return number(numerator, denominator);
635    }
636
637    public static DoubleFloat coerceToFloat(LispObject obj)
638    {
639        if (obj instanceof DoubleFloat)
640            return (DoubleFloat) obj;
641        if (obj instanceof Fixnum)
642            return new DoubleFloat(((Fixnum)obj).value);
643        if (obj instanceof Bignum)
644            return new DoubleFloat(((Bignum)obj).doubleValue());
645        if (obj instanceof SingleFloat)
646            return new DoubleFloat(((SingleFloat)obj).value);
647        if (obj instanceof Ratio)
648            return new DoubleFloat(((Ratio)obj).doubleValue());
649        error(new TypeError("The value " + obj.princToString() +
650                             " cannot be converted to type DOUBLE-FLOAT."));
651        // Not reached.
652        return null;
653    }
654}
Note: See TracBrowser for help on using the repository browser.