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

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

Robustify readably-printed NaNs? in the spirit of #14061
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 21.2 KB
Line 
1/*
2 * SingleFloat.java
3 *
4 * Copyright (C) 2003-2007 Peter Graves
5 * $Id: SingleFloat.java 14062 2012-08-06 19:02:32Z rschlatte $
6 *
7 * This program is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with this program; if not, write to the Free Software
19 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
20 *
21 * As a special exception, the copyright holders of this library give you
22 * permission to link this library with independent modules to produce an
23 * executable, regardless of the license terms of these independent
24 * modules, and to copy and distribute the resulting executable under
25 * terms of your choice, provided that you also meet, for each linked
26 * independent module, the terms and conditions of the license of that
27 * module.  An independent module is a module which is not derived from
28 * or based on this library.  If you modify this library, you may extend
29 * this exception to your version of the library, but you are not
30 * obligated to do so.  If you do not wish to do so, delete this
31 * exception statement from your version.
32 */
33
34package org.armedbear.lisp;
35
36import static org.armedbear.lisp.Lisp.*;
37
38import java.math.BigInteger;
39
40public final class 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 instanceof SingleFloat)
173            return value == ((SingleFloat)obj).value;
174        if (obj instanceof DoubleFloat)
175            return value == ((DoubleFloat)obj).value;
176        if (obj instanceof Fixnum)
177            return value == ((Fixnum)obj).value;
178        if (obj instanceof Bignum)
179            return value == ((Bignum)obj).floatValue();
180        if (obj instanceof Ratio)
181            return value == ((Ratio)obj).floatValue();
182        return false;
183    }
184
185    @Override
186    public LispObject ABS()
187    {
188        if (value > 0)
189            return this;
190        if (value == 0) // 0.0 or -0.0
191            return ZERO;
192        return new SingleFloat(- value);
193    }
194
195    @Override
196    public boolean plusp()
197    {
198        return value > 0;
199    }
200
201    @Override
202    public boolean minusp()
203    {
204        return value < 0;
205    }
206
207    @Override
208    public boolean zerop()
209    {
210        return value == 0;
211    }
212
213    @Override
214    public boolean floatp()
215    {
216        return true;
217    }
218
219    public static double getValue(LispObject obj)
220    {
221        if (obj instanceof SingleFloat)
222            return ((SingleFloat)obj).value;
223        type_error(obj, Symbol.FLOAT);
224        // not reached
225        return 0.0D;
226    }
227
228    public final float getValue()
229    {
230        return value;
231    }
232
233    @Override
234    public float floatValue() {
235        return value;
236    }
237
238    @Override
239    public double doubleValue() {
240        return value;
241    }
242
243    @Override
244    public Object javaInstance()
245    {
246        return Float.valueOf(value);
247    }
248
249    @Override
250    public Object javaInstance(Class c)
251    {
252        String cn = c.getName();
253        if (cn.equals("java.lang.Float") || cn.equals("float"))
254            return Float.valueOf(value);
255        return javaInstance();
256    }
257
258    @Override
259    public final LispObject incr()
260    {
261        return new SingleFloat(value + 1);
262    }
263
264    @Override
265    public final LispObject decr()
266    {
267        return new SingleFloat(value - 1);
268    }
269
270    @Override
271    public LispObject add(LispObject obj)
272    {
273        if (obj instanceof Fixnum)
274            return new SingleFloat(value + ((Fixnum)obj).value);
275        if (obj instanceof SingleFloat)
276            return new SingleFloat(value + ((SingleFloat)obj).value);
277        if (obj instanceof DoubleFloat)
278            return new DoubleFloat(value + ((DoubleFloat)obj).value);
279        if (obj instanceof Bignum)
280            return new SingleFloat(value + ((Bignum)obj).floatValue());
281        if (obj instanceof Ratio)
282            return new SingleFloat(value + ((Ratio)obj).floatValue());
283        if (obj instanceof Complex) {
284            Complex c = (Complex) obj;
285            return Complex.getInstance(add(c.getRealPart()), c.getImaginaryPart());
286        }
287        return error(new TypeError(obj, Symbol.NUMBER));
288    }
289
290    @Override
291    public LispObject negate()
292    {
293        if (value == 0) {
294            int bits = Float.floatToRawIntBits(value);
295            return (bits < 0) ? ZERO : MINUS_ZERO;
296        }
297        return new SingleFloat(-value);
298    }
299
300    @Override
301    public LispObject subtract(LispObject obj)
302    {
303        if (obj instanceof Fixnum)
304            return new SingleFloat(value - ((Fixnum)obj).value);
305        if (obj instanceof SingleFloat)
306            return new SingleFloat(value - ((SingleFloat)obj).value);
307        if (obj instanceof DoubleFloat)
308            return new DoubleFloat(value - ((DoubleFloat)obj).value);
309        if (obj instanceof Bignum)
310            return new SingleFloat(value - ((Bignum)obj).floatValue());
311        if (obj instanceof Ratio)
312            return new SingleFloat(value - ((Ratio)obj).floatValue());
313        if (obj instanceof Complex) {
314            Complex c = (Complex) obj;
315            return Complex.getInstance(subtract(c.getRealPart()),
316                                       ZERO.subtract(c.getImaginaryPart()));
317        }
318        return error(new TypeError(obj, Symbol.NUMBER));
319    }
320
321    @Override
322    public LispObject multiplyBy(LispObject obj)
323    {
324        if (obj instanceof Fixnum)
325            return new SingleFloat(value * ((Fixnum)obj).value);
326        if (obj instanceof SingleFloat)
327            return new SingleFloat(value * ((SingleFloat)obj).value);
328        if (obj instanceof DoubleFloat)
329            return new DoubleFloat(value * ((DoubleFloat)obj).value);
330        if (obj instanceof Bignum)
331            return new SingleFloat(value * ((Bignum)obj).floatValue());
332        if (obj instanceof Ratio)
333            return new SingleFloat(value * ((Ratio)obj).floatValue());
334        if (obj instanceof Complex) {
335            Complex c = (Complex) obj;
336            return Complex.getInstance(multiplyBy(c.getRealPart()),
337                                       multiplyBy(c.getImaginaryPart()));
338        }
339        return error(new TypeError(obj, Symbol.NUMBER));
340    }
341
342    @Override
343    public LispObject divideBy(LispObject obj)
344    {
345        if (obj instanceof Fixnum)
346            return new SingleFloat(value / ((Fixnum)obj).value);
347        if (obj instanceof SingleFloat)
348            return new SingleFloat(value / ((SingleFloat)obj).value);
349        if (obj instanceof DoubleFloat)
350            return new DoubleFloat(value / ((DoubleFloat)obj).value);
351        if (obj instanceof Bignum)
352            return new SingleFloat(value / ((Bignum)obj).floatValue());
353        if (obj instanceof Ratio)
354            return new SingleFloat(value / ((Ratio)obj).floatValue());
355        if (obj instanceof Complex) {
356            Complex c = (Complex) obj;
357            LispObject re = c.getRealPart();
358            LispObject im = c.getImaginaryPart();
359            LispObject denom = re.multiplyBy(re).add(im.multiplyBy(im));
360            LispObject resX = multiplyBy(re).divideBy(denom);
361            LispObject resY =
362                multiplyBy(Fixnum.MINUS_ONE).multiplyBy(im).divideBy(denom);
363            return Complex.getInstance(resX, resY);
364        }
365        return error(new TypeError(obj, Symbol.NUMBER));
366    }
367
368    @Override
369    public boolean isEqualTo(LispObject obj)
370    {
371        if (obj instanceof Fixnum)
372            return rational().isEqualTo(obj);
373        if (obj instanceof SingleFloat)
374            return value == ((SingleFloat)obj).value;
375        if (obj instanceof DoubleFloat)
376            return value == ((DoubleFloat)obj).value;
377        if (obj instanceof Bignum)
378            return rational().isEqualTo(obj);
379        if (obj instanceof Ratio)
380            return rational().isEqualTo(obj);
381        if (obj instanceof Complex)
382            return obj.isEqualTo(this);
383        error(new TypeError(obj, Symbol.NUMBER));
384        // Not reached.
385        return false;
386    }
387
388    @Override
389    public boolean isNotEqualTo(LispObject obj)
390    {
391        return !isEqualTo(obj);
392    }
393
394    @Override
395    public boolean isLessThan(LispObject obj)
396    {
397        if (obj instanceof Fixnum)
398            return rational().isLessThan(obj);
399        if (obj instanceof SingleFloat)
400            return value < ((SingleFloat)obj).value;
401        if (obj instanceof DoubleFloat)
402            return value < ((DoubleFloat)obj).value;
403        if (obj instanceof Bignum)
404            return rational().isLessThan(obj);
405        if (obj instanceof Ratio)
406            return rational().isLessThan(obj);
407        error(new TypeError(obj, Symbol.REAL));
408        // Not reached.
409        return false;
410    }
411
412    @Override
413    public boolean isGreaterThan(LispObject obj)
414    {
415        if (obj instanceof Fixnum)
416            return rational().isGreaterThan(obj);
417        if (obj instanceof SingleFloat)
418            return value > ((SingleFloat)obj).value;
419        if (obj instanceof DoubleFloat)
420            return value > ((DoubleFloat)obj).value;
421        if (obj instanceof Bignum)
422            return rational().isGreaterThan(obj);
423        if (obj instanceof Ratio)
424            return rational().isGreaterThan(obj);
425        error(new TypeError(obj, Symbol.REAL));
426        // Not reached.
427        return false;
428    }
429
430    @Override
431    public boolean isLessThanOrEqualTo(LispObject obj)
432    {
433        if (obj instanceof Fixnum)
434            return rational().isLessThanOrEqualTo(obj);
435        if (obj instanceof SingleFloat)
436            return value <= ((SingleFloat)obj).value;
437        if (obj instanceof DoubleFloat)
438            return value <= ((DoubleFloat)obj).value;
439        if (obj instanceof Bignum)
440            return rational().isLessThanOrEqualTo(obj);
441        if (obj instanceof Ratio)
442            return rational().isLessThanOrEqualTo(obj);
443        error(new TypeError(obj, Symbol.REAL));
444        // Not reached.
445        return false;
446    }
447
448    @Override
449    public boolean isGreaterThanOrEqualTo(LispObject obj)
450    {
451        if (obj instanceof Fixnum)
452            return rational().isGreaterThanOrEqualTo(obj);
453        if (obj instanceof SingleFloat)
454            return value >= ((SingleFloat)obj).value;
455        if (obj instanceof DoubleFloat)
456            return value >= ((DoubleFloat)obj).value;
457        if (obj instanceof Bignum)
458            return rational().isGreaterThanOrEqualTo(obj);
459        if (obj instanceof Ratio)
460            return rational().isGreaterThanOrEqualTo(obj);
461        error(new TypeError(obj, Symbol.REAL));
462        // Not reached.
463        return false;
464    }
465
466    @Override
467    public LispObject truncate(LispObject obj)
468    {
469        // "When rationals and floats are combined by a numerical function,
470        // the rational is first converted to a float of the same format."
471        // 12.1.4.1
472        if (obj instanceof Fixnum) {
473            return truncate(new SingleFloat(((Fixnum)obj).value));
474        }
475        if (obj instanceof Bignum) {
476            return truncate(new SingleFloat(((Bignum)obj).floatValue()));
477        }
478        if (obj instanceof Ratio) {
479            return truncate(new SingleFloat(((Ratio)obj).floatValue()));
480        }
481        if (obj instanceof SingleFloat) {
482            final LispThread thread = LispThread.currentThread();
483            float divisor = ((SingleFloat)obj).value;
484            float quotient = value / divisor;
485            if (value != 0)
486                MathFunctions.OverUnderFlowCheck(quotient);
487            if (quotient >= Integer.MIN_VALUE && quotient <= Integer.MAX_VALUE) {
488                int q = (int) quotient;
489                return thread.setValues(Fixnum.getInstance(q),
490                                        new SingleFloat(value - q * divisor));
491            }
492            // We need to convert the quotient to a bignum.
493            int bits = Float.floatToRawIntBits(quotient);
494            int s = ((bits >> 31) == 0) ? 1 : -1;
495            int e = (int) ((bits >> 23) & 0xff);
496            long m;
497            if (e == 0)
498                m = (bits & 0x7fffff) << 1;
499            else
500                m = (bits & 0x7fffff) | 0x800000;
501            LispObject significand = number(m);
502            Fixnum exponent = Fixnum.getInstance(e - 150);
503            Fixnum sign = Fixnum.getInstance(s);
504            LispObject result = significand;
505            result =
506                result.multiplyBy(MathFunctions.EXPT.execute(Fixnum.TWO, exponent));
507            result = result.multiplyBy(sign);
508            // Calculate remainder.
509            LispObject product = result.multiplyBy(obj);
510            LispObject remainder = subtract(product);
511            return thread.setValues(result, remainder);
512        }
513        if (obj instanceof DoubleFloat) {
514            final LispThread thread = LispThread.currentThread();
515            double divisor = ((DoubleFloat)obj).value;
516            double quotient = value / divisor;
517            if (value != 0)
518                MathFunctions.OverUnderFlowCheck(quotient);
519            if (quotient >= Integer.MIN_VALUE && quotient <= Integer.MAX_VALUE) {
520                int q = (int) quotient;
521                return thread.setValues(Fixnum.getInstance(q),
522                                        new DoubleFloat(value - q * divisor));
523            }
524            // We need to convert the quotient to a bignum.
525            long bits = Double.doubleToRawLongBits((double)quotient);
526            int s = ((bits >> 63) == 0) ? 1 : -1;
527            int e = (int) ((bits >> 52) & 0x7ffL);
528            long m;
529            if (e == 0)
530                m = (bits & 0xfffffffffffffL) << 1;
531            else
532                m = (bits & 0xfffffffffffffL) | 0x10000000000000L;
533            LispObject significand = number(m);
534            Fixnum exponent = Fixnum.getInstance(e - 1075);
535            Fixnum sign = Fixnum.getInstance(s);
536            LispObject result = significand;
537            result =
538                result.multiplyBy(MathFunctions.EXPT.execute(Fixnum.TWO, exponent));
539            result = result.multiplyBy(sign);
540            // Calculate remainder.
541            LispObject product = result.multiplyBy(obj);
542            LispObject remainder = subtract(product);
543            return thread.setValues(result, remainder);
544        }
545        return error(new TypeError(obj, Symbol.REAL));
546    }
547
548    @Override
549    public int hashCode()
550    {
551        return Float.floatToIntBits(value);
552    }
553
554    @Override
555    public int psxhash()
556    {
557        if ((value % 1) == 0)
558            return (((int)value) & 0x7fffffff);
559        else
560            return (hashCode() & 0x7fffffff);
561    }
562
563    @Override
564    public String printObject()
565    {
566        if (value == Float.POSITIVE_INFINITY) {
567            StringBuffer sb = new StringBuffer("#.");
568            sb.append(Symbol.SINGLE_FLOAT_POSITIVE_INFINITY.printObject());
569            return sb.toString();
570        }
571        if (value == Float.NEGATIVE_INFINITY) {
572            StringBuffer sb = new StringBuffer("#.");
573            sb.append(Symbol.SINGLE_FLOAT_NEGATIVE_INFINITY.printObject());
574            return sb.toString();
575        }
576
577        LispThread thread = LispThread.currentThread();
578        boolean printReadably = Symbol.PRINT_READABLY.symbolValue(thread) != NIL;
579
580        if (value != value) {
581            if (printReadably)
582                return "#.(CL:PROGN \"Comment: create a NaN.\" (CL:/ 0.0s0 0.0s0))";
583            else
584                return unreadableString("SINGLE-FLOAT NaN", false);
585        }
586        String s1 = String.valueOf(value);
587        if (printReadably ||
588            !memq(Symbol.READ_DEFAULT_FLOAT_FORMAT.symbolValue(thread),
589                  list(Symbol.SINGLE_FLOAT, Symbol.SHORT_FLOAT)))
590        {
591            if (s1.indexOf('E') >= 0)
592                return s1.replace('E', 'f');
593            else
594                return s1.concat("f0");
595        } else
596            return s1;
597    }
598
599    public LispObject rational()
600    {
601        final int bits = Float.floatToRawIntBits(value);
602        int sign = ((bits >> 31) == 0) ? 1 : -1;
603        int storedExponent = ((bits >> 23) & 0xff);
604        long mantissa;
605        if (storedExponent == 0)
606            mantissa = (bits & 0x7fffff) << 1;
607        else
608            mantissa = (bits & 0x7fffff) | 0x800000;
609        if (mantissa == 0)
610            return Fixnum.ZERO;
611        if (sign < 0)
612            mantissa = -mantissa;
613        // Subtract bias.
614        final int exponent = storedExponent - 127;
615        BigInteger numerator, denominator;
616        if (exponent < 0) {
617            numerator = BigInteger.valueOf(mantissa);
618            denominator = BigInteger.valueOf(1).shiftLeft(23 - exponent);
619        } else {
620            numerator = BigInteger.valueOf(mantissa).shiftLeft(exponent);
621            denominator = BigInteger.valueOf(0x800000); // (ash 1 23)
622        }
623        return number(numerator, denominator);
624    }
625
626    public static SingleFloat coerceToFloat(LispObject obj)
627    {
628        if (obj instanceof Fixnum)
629            return new SingleFloat(((Fixnum)obj).value);
630        if (obj instanceof SingleFloat)
631            return (SingleFloat) obj;
632        if (obj instanceof DoubleFloat) {
633            float result = (float)((DoubleFloat)obj).value;
634            if (Float.isInfinite(result) && TRAP_OVERFLOW)
635                type_error(obj, Symbol.SINGLE_FLOAT);
636
637            return new SingleFloat(result);
638        }
639        if (obj instanceof Bignum)
640            return new SingleFloat(((Bignum)obj).floatValue());
641        if (obj instanceof Ratio)
642            return new SingleFloat(((Ratio)obj).floatValue());
643        error(new TypeError("The value " + obj.princToString() +
644                             " cannot be converted to type SINGLE-FLOAT."));
645        // Not reached.
646        return null;
647    }
648}
Note: See TracBrowser for help on using the repository browser.