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

Last change on this file was 14757, checked in by Mark Evenson, 10 years ago

Futher fix for EQUALP on numeric tower

This fixes the following case

(let ((h1 (make-hash-table :test 'equalp))

(h2 (make-hash-table :test 'equalp))
(h (make-hash-table :test 'equalp)))

(setf (gethash 1 h1) 2

(gethash 2 h2) 1
(gethash h1 h) h2
(gethash h2 h) h1)

h)

See <​https://mailman.common-lisp.net/pipermail/armedbear-devel/2015-April/003452.html>.
See <​http://abcl.org/trac/ticket/388>.

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