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

Last change on this file was 12288, checked in by vvoutilainen, 16 years ago

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