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

Last change on this file was 12254, checked in by ehuelsmann, 16 years ago

Remove 'throws ConditionThrowable?' method annotations:

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