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

Last change on this file was 15228, checked in by Mark Evenson, 4 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: 20.7 KB
Line 
1/*
2 * SingleFloat.java
3 *
4 * Copyright (C) 2003-2007 Peter Graves
5 * $Id: SingleFloat.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 SingleFloat extends LispObject
41{
42    public static final SingleFloat ZERO       = new SingleFloat(0);
43    public static final SingleFloat MINUS_ZERO = new SingleFloat(-0.0f);
44    public static final SingleFloat ONE        = new SingleFloat(1);
45    public static final SingleFloat MINUS_ONE  = new SingleFloat(-1);
46
47    public static final SingleFloat SINGLE_FLOAT_POSITIVE_INFINITY =
48        new SingleFloat(Float.POSITIVE_INFINITY);
49
50    public static final SingleFloat SINGLE_FLOAT_NEGATIVE_INFINITY =
51        new SingleFloat(Float.NEGATIVE_INFINITY);
52
53    static {
54        Symbol.SINGLE_FLOAT_POSITIVE_INFINITY.initializeConstant(SINGLE_FLOAT_POSITIVE_INFINITY);
55        Symbol.SINGLE_FLOAT_NEGATIVE_INFINITY.initializeConstant(SINGLE_FLOAT_NEGATIVE_INFINITY);
56    }
57
58    public static SingleFloat getInstance(float f) {
59        if (f == 0) {
60            int bits = Float.floatToRawIntBits(f);
61            if (bits < 0)
62                return MINUS_ZERO;
63            else
64                return ZERO;
65        }
66        else if (f == 1)
67            return ONE;
68        else if (f == -1)
69            return MINUS_ONE;
70        else
71            return new SingleFloat(f);
72    }
73
74    public final float value;
75
76    public SingleFloat(float value)
77    {
78        this.value = value;
79    }
80
81    @Override
82    public LispObject typeOf()
83    {
84        return Symbol.SINGLE_FLOAT;
85    }
86
87    @Override
88    public LispObject classOf()
89    {
90        return BuiltInClass.SINGLE_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.SINGLE_FLOAT)
103            return T;
104        if (typeSpecifier == Symbol.SHORT_FLOAT)
105            return T;
106        if (typeSpecifier == BuiltInClass.FLOAT)
107            return T;
108        if (typeSpecifier == BuiltInClass.SINGLE_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 SingleFloat) {
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                float f = ((SingleFloat)obj).value;
135                int bits = Float.floatToRawIntBits(f);
136                return bits == Float.floatToRawIntBits(value);
137            }
138            if (value == ((SingleFloat)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 SingleFloat) {
150            if (value == 0) {
151                // same as EQL
152                float f = ((SingleFloat)obj).value;
153                int bits = Float.floatToRawIntBits(f);
154                return bits == Float.floatToRawIntBits(value);
155            }
156            if (value == ((SingleFloat)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 SingleFloat(- 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 SingleFloat)
214            return ((SingleFloat)obj).value;
215        type_error(obj, Symbol.FLOAT);
216        // not reached
217        return 0.0D;
218    }
219
220    public final float getValue()
221    {
222        return value;
223    }
224
225    @Override
226    public float floatValue() {
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 Float.valueOf(value);
239    }
240
241    @Override
242    public Object javaInstance(Class c)
243    {
244        if (c == Float.class || c == float.class)
245            return Float.valueOf(value);
246        return javaInstance();
247    }
248
249    @Override
250    public final LispObject incr()
251    {
252        return new SingleFloat(value + 1);
253    }
254
255    @Override
256    public final LispObject decr()
257    {
258        return new SingleFloat(value - 1);
259    }
260
261    @Override
262    public LispObject add(LispObject obj)
263    {
264        if (obj instanceof Fixnum)
265            return new SingleFloat(value + ((Fixnum)obj).value);
266        if (obj instanceof SingleFloat)
267            return new SingleFloat(value + ((SingleFloat)obj).value);
268        if (obj instanceof DoubleFloat)
269            return new DoubleFloat(value + ((DoubleFloat)obj).value);
270        if (obj instanceof Bignum)
271            return new SingleFloat(value + ((Bignum)obj).floatValue());
272        if (obj instanceof Ratio)
273            return new SingleFloat(value + ((Ratio)obj).floatValue());
274        if (obj instanceof Complex) {
275            Complex c = (Complex) obj;
276            return Complex.getInstance(add(c.getRealPart()), c.getImaginaryPart());
277        }
278        return type_error(obj, Symbol.NUMBER);
279    }
280
281    @Override
282    public LispObject negate()
283    {
284        if (value == 0) {
285            int bits = Float.floatToRawIntBits(value);
286            return (bits < 0) ? ZERO : MINUS_ZERO;
287        }
288        return new SingleFloat(-value);
289    }
290
291    @Override
292    public LispObject subtract(LispObject obj)
293    {
294        if (obj instanceof Fixnum)
295            return new SingleFloat(value - ((Fixnum)obj).value);
296        if (obj instanceof SingleFloat)
297            return new SingleFloat(value - ((SingleFloat)obj).value);
298        if (obj instanceof DoubleFloat)
299            return new DoubleFloat(value - ((DoubleFloat)obj).value);
300        if (obj instanceof Bignum)
301            return new SingleFloat(value - ((Bignum)obj).floatValue());
302        if (obj instanceof Ratio)
303            return new SingleFloat(value - ((Ratio)obj).floatValue());
304        if (obj instanceof Complex) {
305            Complex c = (Complex) obj;
306            return Complex.getInstance(subtract(c.getRealPart()),
307                                       ZERO.subtract(c.getImaginaryPart()));
308        }
309        return type_error(obj, Symbol.NUMBER);
310    }
311
312    @Override
313    public LispObject multiplyBy(LispObject obj)
314    {
315        if (obj instanceof Fixnum)
316            return new SingleFloat(value * ((Fixnum)obj).value);
317        if (obj instanceof SingleFloat)
318            return new SingleFloat(value * ((SingleFloat)obj).value);
319        if (obj instanceof DoubleFloat)
320            return new DoubleFloat(value * ((DoubleFloat)obj).value);
321        if (obj instanceof Bignum)
322            return new SingleFloat(value * ((Bignum)obj).floatValue());
323        if (obj instanceof Ratio)
324            return new SingleFloat(value * ((Ratio)obj).floatValue());
325        if (obj instanceof Complex) {
326            Complex c = (Complex) obj;
327            return Complex.getInstance(multiplyBy(c.getRealPart()),
328                                       multiplyBy(c.getImaginaryPart()));
329        }
330        return type_error(obj, Symbol.NUMBER);
331    }
332
333    @Override
334    public LispObject divideBy(LispObject obj)
335    {
336        if (obj instanceof Fixnum)
337            return new SingleFloat(value / ((Fixnum)obj).value);
338        if (obj instanceof SingleFloat)
339            return new SingleFloat(value / ((SingleFloat)obj).value);
340        if (obj instanceof DoubleFloat)
341            return new DoubleFloat(value / ((DoubleFloat)obj).value);
342        if (obj instanceof Bignum)
343            return new SingleFloat(value / ((Bignum)obj).floatValue());
344        if (obj instanceof Ratio)
345            return new SingleFloat(value / ((Ratio)obj).floatValue());
346        if (obj instanceof Complex) {
347            Complex c = (Complex) obj;
348            LispObject re = c.getRealPart();
349            LispObject im = c.getImaginaryPart();
350            LispObject denom = re.multiplyBy(re).add(im.multiplyBy(im));
351            LispObject resX = multiplyBy(re).divideBy(denom);
352            LispObject resY =
353                multiplyBy(Fixnum.MINUS_ONE).multiplyBy(im).divideBy(denom);
354            return Complex.getInstance(resX, resY);
355        }
356        return type_error(obj, Symbol.NUMBER);
357    }
358
359    @Override
360    public boolean isEqualTo(LispObject obj)
361    {
362        if (obj instanceof Fixnum)
363            return rational().isEqualTo(obj);
364        if (obj instanceof SingleFloat)
365            return value == ((SingleFloat)obj).value;
366        if (obj instanceof DoubleFloat)
367            return value == ((DoubleFloat)obj).value;
368        if (obj instanceof Bignum)
369            return rational().isEqualTo(obj);
370        if (obj instanceof Ratio)
371            return rational().isEqualTo(obj);
372        if (obj instanceof Complex)
373            return obj.isEqualTo(this);
374        type_error(obj, Symbol.NUMBER);
375        // Not reached.
376        return false;
377    }
378
379    @Override
380    public boolean isNotEqualTo(LispObject obj)
381    {
382        return !isEqualTo(obj);
383    }
384
385    @Override
386    public boolean isLessThan(LispObject obj)
387    {
388        if (obj instanceof Fixnum)
389            return rational().isLessThan(obj);
390        if (obj instanceof SingleFloat)
391            return value < ((SingleFloat)obj).value;
392        if (obj instanceof DoubleFloat)
393            return value < ((DoubleFloat)obj).value;
394        if (obj instanceof Bignum)
395            return rational().isLessThan(obj);
396        if (obj instanceof Ratio)
397            return rational().isLessThan(obj);
398        type_error(obj, Symbol.REAL);
399        // Not reached.
400        return false;
401    }
402
403    @Override
404    public boolean isGreaterThan(LispObject obj)
405    {
406        if (obj instanceof Fixnum)
407            return rational().isGreaterThan(obj);
408        if (obj instanceof SingleFloat)
409            return value > ((SingleFloat)obj).value;
410        if (obj instanceof DoubleFloat)
411            return value > ((DoubleFloat)obj).value;
412        if (obj instanceof Bignum)
413            return rational().isGreaterThan(obj);
414        if (obj instanceof Ratio)
415            return rational().isGreaterThan(obj);
416        type_error(obj, Symbol.REAL);
417        // Not reached.
418        return false;
419    }
420
421    @Override
422    public boolean isLessThanOrEqualTo(LispObject obj)
423    {
424        if (obj instanceof Fixnum)
425            return rational().isLessThanOrEqualTo(obj);
426        if (obj instanceof SingleFloat)
427            return value <= ((SingleFloat)obj).value;
428        if (obj instanceof DoubleFloat)
429            return value <= ((DoubleFloat)obj).value;
430        if (obj instanceof Bignum)
431            return rational().isLessThanOrEqualTo(obj);
432        if (obj instanceof Ratio)
433            return rational().isLessThanOrEqualTo(obj);
434        type_error(obj, Symbol.REAL);
435        // Not reached.
436        return false;
437    }
438
439    @Override
440    public boolean isGreaterThanOrEqualTo(LispObject obj)
441    {
442        if (obj instanceof Fixnum)
443            return rational().isGreaterThanOrEqualTo(obj);
444        if (obj instanceof SingleFloat)
445            return value >= ((SingleFloat)obj).value;
446        if (obj instanceof DoubleFloat)
447            return value >= ((DoubleFloat)obj).value;
448        if (obj instanceof Bignum)
449            return rational().isGreaterThanOrEqualTo(obj);
450        if (obj instanceof Ratio)
451            return rational().isGreaterThanOrEqualTo(obj);
452        type_error(obj, Symbol.REAL);
453        // Not reached.
454        return false;
455    }
456
457    @Override
458    public LispObject truncate(LispObject obj)
459    {
460        // "When rationals and floats are combined by a numerical function,
461        // the rational is first converted to a float of the same format."
462        // 12.1.4.1
463        if (obj instanceof Fixnum) {
464            return truncate(new SingleFloat(((Fixnum)obj).value));
465        }
466        if (obj instanceof Bignum) {
467            return truncate(new SingleFloat(((Bignum)obj).floatValue()));
468        }
469        if (obj instanceof Ratio) {
470            return truncate(new SingleFloat(((Ratio)obj).floatValue()));
471        }
472        if (obj instanceof SingleFloat) {
473            final LispThread thread = LispThread.currentThread();
474            float divisor = ((SingleFloat)obj).value;
475            float quotient = value / divisor;
476            if (value != 0)
477                MathFunctions.OverUnderFlowCheck(quotient);
478            if (quotient >= Integer.MIN_VALUE && quotient <= Integer.MAX_VALUE) {
479                int q = (int) quotient;
480                return thread.setValues(Fixnum.getInstance(q),
481                                        new SingleFloat(value - q * divisor));
482            }
483            // We need to convert the quotient to a bignum.
484            int bits = Float.floatToRawIntBits(quotient);
485            int s = ((bits >> 31) == 0) ? 1 : -1;
486            int e = (int) ((bits >> 23) & 0xff);
487            long m;
488            if (e == 0)
489                m = (bits & 0x7fffff) << 1;
490            else
491                m = (bits & 0x7fffff) | 0x800000;
492            LispObject significand = number(m);
493            Fixnum exponent = Fixnum.getInstance(e - 150);
494            Fixnum sign = Fixnum.getInstance(s);
495            LispObject result = significand;
496            result =
497                result.multiplyBy(MathFunctions.EXPT.execute(Fixnum.TWO, exponent));
498            result = result.multiplyBy(sign);
499            // Calculate remainder.
500            LispObject product = result.multiplyBy(obj);
501            LispObject remainder = subtract(product);
502            return thread.setValues(result, remainder);
503        }
504        if (obj instanceof DoubleFloat) {
505            final LispThread thread = LispThread.currentThread();
506            double divisor = ((DoubleFloat)obj).value;
507            double quotient = value / divisor;
508            if (value != 0)
509                MathFunctions.OverUnderFlowCheck(quotient);
510            if (quotient >= Integer.MIN_VALUE && quotient <= Integer.MAX_VALUE) {
511                int q = (int) quotient;
512                return thread.setValues(Fixnum.getInstance(q),
513                                        new DoubleFloat(value - q * divisor));
514            }
515            // We need to convert the quotient to a bignum.
516            long bits = Double.doubleToRawLongBits((double)quotient);
517            int s = ((bits >> 63) == 0) ? 1 : -1;
518            int e = (int) ((bits >> 52) & 0x7ffL);
519            long m;
520            if (e == 0)
521                m = (bits & 0xfffffffffffffL) << 1;
522            else
523                m = (bits & 0xfffffffffffffL) | 0x10000000000000L;
524            LispObject significand = number(m);
525            Fixnum exponent = Fixnum.getInstance(e - 1075);
526            Fixnum sign = Fixnum.getInstance(s);
527            LispObject result = significand;
528            result =
529                result.multiplyBy(MathFunctions.EXPT.execute(Fixnum.TWO, exponent));
530            result = result.multiplyBy(sign);
531            // Calculate remainder.
532            LispObject product = result.multiplyBy(obj);
533            LispObject remainder = subtract(product);
534            return thread.setValues(result, remainder);
535        }
536        return type_error(obj, Symbol.REAL);
537    }
538
539    @Override
540    public int hashCode()
541    {
542        return Float.floatToIntBits(value);
543    }
544
545    @Override
546    public int psxhash()
547    {
548        if ((value % 1) == 0)
549            return (((int)value) & 0x7fffffff);
550        else
551            return (hashCode() & 0x7fffffff);
552    }
553
554    @Override
555    public String printObject()
556    {
557        if (value == Float.POSITIVE_INFINITY) {
558            StringBuffer sb = new StringBuffer("#.");
559            sb.append(Symbol.SINGLE_FLOAT_POSITIVE_INFINITY.printObject());
560            return sb.toString();
561        }
562        if (value == Float.NEGATIVE_INFINITY) {
563            StringBuffer sb = new StringBuffer("#.");
564            sb.append(Symbol.SINGLE_FLOAT_NEGATIVE_INFINITY.printObject());
565            return sb.toString();
566        }
567
568        LispThread thread = LispThread.currentThread();
569        boolean printReadably = Symbol.PRINT_READABLY.symbolValue(thread) != NIL;
570
571        if (value != value) {
572            if (printReadably)
573                return "#.(CL:PROGN \"Comment: create a NaN.\" (CL:/ 0.0s0 0.0s0))";
574            else
575                return unreadableString("SINGLE-FLOAT NaN", false);
576        }
577        String s1 = String.valueOf(value);
578        if (printReadably ||
579            !memq(Symbol.READ_DEFAULT_FLOAT_FORMAT.symbolValue(thread),
580                  list(Symbol.SINGLE_FLOAT, Symbol.SHORT_FLOAT)))
581        {
582            if (s1.indexOf('E') >= 0)
583                return s1.replace('E', 'f');
584            else
585                return s1.concat("f0");
586        } else
587            return s1;
588    }
589
590    public LispObject rational()
591    {
592        final int bits = Float.floatToRawIntBits(value);
593        int sign = ((bits >> 31) == 0) ? 1 : -1;
594        int storedExponent = ((bits >> 23) & 0xff);
595        long mantissa;
596        if (storedExponent == 0)
597            mantissa = (bits & 0x7fffff) << 1;
598        else
599            mantissa = (bits & 0x7fffff) | 0x800000;
600        if (mantissa == 0)
601            return Fixnum.ZERO;
602        if (sign < 0)
603            mantissa = -mantissa;
604        // Subtract bias.
605        final int exponent = storedExponent - 127;
606        BigInteger numerator, denominator;
607        if (exponent < 0) {
608            numerator = BigInteger.valueOf(mantissa);
609            denominator = BigInteger.valueOf(1).shiftLeft(23 - exponent);
610        } else {
611            numerator = BigInteger.valueOf(mantissa).shiftLeft(exponent);
612            denominator = BigInteger.valueOf(0x800000); // (ash 1 23)
613        }
614        return number(numerator, denominator);
615    }
616
617    public static SingleFloat coerceToFloat(LispObject obj)
618    {
619        if (obj instanceof Fixnum)
620            return new SingleFloat(((Fixnum)obj).value);
621        if (obj instanceof SingleFloat)
622            return (SingleFloat) obj;
623        if (obj instanceof DoubleFloat) {
624            float result = (float)((DoubleFloat)obj).value;
625            if (Float.isInfinite(result) && TRAP_OVERFLOW)
626                type_error(obj, Symbol.SINGLE_FLOAT);
627
628            return new SingleFloat(result);
629        }
630        if (obj instanceof Bignum)
631            return new SingleFloat(((Bignum)obj).floatValue());
632        if (obj instanceof Ratio)
633            return new SingleFloat(((Ratio)obj).floatValue());
634        error(new TypeError("The value " + obj.princToString() +
635                             " cannot be converted to type SINGLE-FLOAT."));
636        // Not reached.
637        return null;
638    }
639}
Note: See TracBrowser for help on using the repository browser.