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

Last change on this file was 12431, checked in by Mark Evenson, 15 years ago

Replace FastStringBuffer? with java.lang.StringBuilder?.

Phil Hudson suggested in Feburary 2009 that "[FastStringBuffer?] should
be removed with all references to it replaced with
java.lang.StringBuilder? once enough confidence in this change has been
gained." After almost a year of using FastStringBuffer? as a delagate
for StringBuilder?, that confidence has indeed been gained.

One subtlety for use of StringBuilder?: there is no

StringBuilder?(char)

constructor, so use

StringBuilder?(String.valueOf(c))

to construct a new StringBuilder? containing a single char. Otherwise
that char will get promoted to an int, and you will invoke

StringBuilder?(int capacity)

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