source: trunk/abcl/src/org/armedbear/lisp/DoubleFloat.java

Last change on this file was 15228, checked in by Mark Evenson, 5 years ago

Revert somewhat-functional-programmers work on conversion

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