001: /*
002: * LispFloat.java
003: *
004: * Copyright (C) 2003-2004 Peter Graves
005: * $Id: LispFloat.java,v 1.74 2004/09/21 18:12:14 piso Exp $
006: *
007: * This program is free software; you can redistribute it and/or
008: * modify it under the terms of the GNU General Public License
009: * as published by the Free Software Foundation; either version 2
010: * of the License, or (at your option) any later version.
011: *
012: * This program is distributed in the hope that it will be useful,
013: * but WITHOUT ANY WARRANTY; without even the implied warranty of
014: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
015: * GNU General Public License for more details.
016: *
017: * You should have received a copy of the GNU General Public License
018: * along with this program; if not, write to the Free Software
019: * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
020: */
021:
022: package org.armedbear.lisp;
023:
024: import java.math.BigInteger;
025:
026: public final class LispFloat extends LispObject {
027: public static final LispFloat ZERO = new LispFloat(0);
028: public static final LispFloat ONE = new LispFloat(1);
029: public static final LispFloat MINUS_ONE = new LispFloat(-1);
030:
031: public static final LispFloat PI = new LispFloat(
032: (double) 3.141592653589793);
033:
034: public static final LispFloat DOUBLE_FLOAT_POSITIVE_INFINITY = new LispFloat(
035: Double.POSITIVE_INFINITY);
036:
037: public static final LispFloat DOUBLE_FLOAT_NEGATIVE_INFINITY = new LispFloat(
038: Double.NEGATIVE_INFINITY);
039:
040: static {
041: Symbol.DOUBLE_FLOAT_POSITIVE_INFINITY
042: .setSymbolValue(DOUBLE_FLOAT_POSITIVE_INFINITY);
043: Symbol.DOUBLE_FLOAT_POSITIVE_INFINITY.setConstant(true);
044: Symbol.DOUBLE_FLOAT_NEGATIVE_INFINITY
045: .setSymbolValue(DOUBLE_FLOAT_NEGATIVE_INFINITY);
046: Symbol.DOUBLE_FLOAT_NEGATIVE_INFINITY.setConstant(true);
047: }
048:
049: public final double value;
050:
051: public LispFloat(double value) {
052: this .value = value;
053: }
054:
055: public LispObject typeOf() {
056: return Symbol.FLOAT;
057: }
058:
059: public LispClass classOf() {
060: return BuiltInClass.FLOAT;
061: }
062:
063: public LispObject typep(LispObject typeSpecifier)
064: throws ConditionThrowable {
065: if (typeSpecifier == Symbol.FLOAT)
066: return T;
067: if (typeSpecifier == BuiltInClass.FLOAT)
068: return T;
069: if (typeSpecifier == Symbol.REAL)
070: return T;
071: if (typeSpecifier == Symbol.NUMBER)
072: return T;
073: if (typeSpecifier == Symbol.SINGLE_FLOAT)
074: return T;
075: if (typeSpecifier == Symbol.DOUBLE_FLOAT)
076: return T;
077: if (typeSpecifier == Symbol.SHORT_FLOAT)
078: return T;
079: if (typeSpecifier == Symbol.LONG_FLOAT)
080: return T;
081: return super .typep(typeSpecifier);
082: }
083:
084: public LispObject NUMBERP() {
085: return T;
086: }
087:
088: public boolean numberp() {
089: return true;
090: }
091:
092: public boolean realp() {
093: return true;
094: }
095:
096: public boolean eql(LispObject obj) {
097: if (this == obj)
098: return true;
099: if (obj instanceof LispFloat) {
100: if (value == ((LispFloat) obj).value)
101: return true;
102: }
103: return false;
104: }
105:
106: public boolean equal(LispObject obj) {
107: if (this == obj)
108: return true;
109: if (obj instanceof LispFloat) {
110: if (value == ((LispFloat) obj).value)
111: return true;
112: }
113: return false;
114: }
115:
116: public boolean equalp(LispObject obj) throws ConditionThrowable {
117: if (obj instanceof LispFloat)
118: return value == ((LispFloat) obj).value;
119: if (obj instanceof Fixnum)
120: return value == ((Fixnum) obj).getValue();
121: if (obj instanceof Bignum)
122: return value == ((Bignum) obj).floatValue();
123: if (obj instanceof Ratio)
124: return value == ((Ratio) obj).floatValue();
125: return false;
126: }
127:
128: public LispObject ABS() {
129: if (value > 0)
130: return this ;
131: if (value == 0) // 0.0 or -0.0
132: return LispFloat.ZERO;
133: return new LispFloat(-value);
134: }
135:
136: public boolean plusp() {
137: return value > 0;
138: }
139:
140: public boolean minusp() {
141: return value < 0;
142: }
143:
144: public boolean zerop() {
145: return value == 0;
146: }
147:
148: public LispObject FLOATP() {
149: return T;
150: }
151:
152: public boolean floatp() {
153: return true;
154: }
155:
156: public static double getValue(LispObject obj)
157: throws ConditionThrowable {
158: try {
159: return ((LispFloat) obj).value;
160: } catch (ClassCastException e) {
161: signal(new TypeError(obj, Symbol.FLOAT));
162: // Not reached.
163: return 0;
164: }
165: }
166:
167: public final double getValue() {
168: return value;
169: }
170:
171: public Object javaInstance() {
172: return new Double(value);
173: }
174:
175: public Object javaInstance(Class c) {
176: String cn = c.getName();
177: if (cn.equals("java.lang.Float") || cn.equals("float"))
178: return new Float(value);
179: return javaInstance();
180: }
181:
182: public final LispObject incr() {
183: return new LispFloat(value + 1);
184: }
185:
186: public final LispObject decr() {
187: return new LispFloat(value - 1);
188: }
189:
190: public LispObject add(LispObject obj) throws ConditionThrowable {
191: if (obj instanceof LispFloat)
192: return new LispFloat(value + ((LispFloat) obj).value);
193: if (obj instanceof Fixnum)
194: return new LispFloat(value + ((Fixnum) obj).value);
195: if (obj instanceof Bignum)
196: return new LispFloat(value + ((Bignum) obj).floatValue());
197: if (obj instanceof Ratio)
198: return new LispFloat(value + ((Ratio) obj).floatValue());
199: if (obj instanceof Complex) {
200: Complex c = (Complex) obj;
201: return Complex.getInstance(add(c.getRealPart()), c
202: .getImaginaryPart());
203: }
204: return signal(new TypeError(obj, Symbol.NUMBER));
205: }
206:
207: public LispObject subtract(LispObject obj)
208: throws ConditionThrowable {
209: if (obj instanceof LispFloat)
210: return new LispFloat(value - ((LispFloat) obj).value);
211: if (obj instanceof Fixnum)
212: return new LispFloat(value - ((Fixnum) obj).value);
213: if (obj instanceof Bignum)
214: return new LispFloat(value - ((Bignum) obj).floatValue());
215: if (obj instanceof Ratio)
216: return new LispFloat(value - ((Ratio) obj).floatValue());
217: if (obj instanceof Complex) {
218: Complex c = (Complex) obj;
219: return Complex.getInstance(subtract(c.getRealPart()), ZERO
220: .subtract(c.getImaginaryPart()));
221: }
222: return signal(new TypeError(obj, Symbol.NUMBER));
223: }
224:
225: public LispObject multiplyBy(LispObject obj)
226: throws ConditionThrowable {
227: if (obj instanceof LispFloat)
228: return new LispFloat(value * ((LispFloat) obj).value);
229: if (obj instanceof Fixnum)
230: return new LispFloat(value * ((Fixnum) obj).value);
231: if (obj instanceof Bignum)
232: return new LispFloat(value * ((Bignum) obj).floatValue());
233: if (obj instanceof Ratio)
234: return new LispFloat(value * ((Ratio) obj).floatValue());
235: if (obj instanceof Complex) {
236: Complex c = (Complex) obj;
237: return Complex.getInstance(multiplyBy(c.getRealPart()),
238: multiplyBy(c.getImaginaryPart()));
239: }
240: return signal(new TypeError(obj, Symbol.NUMBER));
241: }
242:
243: public LispObject divideBy(LispObject obj)
244: throws ConditionThrowable {
245: if (obj instanceof LispFloat)
246: return new LispFloat(value / ((LispFloat) obj).value);
247: if (obj instanceof Fixnum)
248: return new LispFloat(value / ((Fixnum) obj).value);
249: if (obj instanceof Bignum)
250: return new LispFloat(value / ((Bignum) obj).floatValue());
251: if (obj instanceof Ratio)
252: return new LispFloat(value / ((Ratio) obj).floatValue());
253: if (obj instanceof Complex) {
254: Complex c = (Complex) obj;
255: LispObject re = c.getRealPart();
256: LispObject im = c.getImaginaryPart();
257: LispObject denom = re.multiplyBy(re).add(im.multiplyBy(im));
258: LispObject resX = multiplyBy(re).divideBy(denom);
259: LispObject resY = multiplyBy(Fixnum.MINUS_ONE).multiplyBy(
260: im).divideBy(denom);
261: return Complex.getInstance(resX, resY);
262: }
263: return signal(new TypeError(obj, Symbol.NUMBER));
264: }
265:
266: public boolean isEqualTo(LispObject obj) throws ConditionThrowable {
267: if (obj instanceof LispFloat)
268: return value == ((LispFloat) obj).value;
269: if (obj instanceof Fixnum)
270: return value == ((Fixnum) obj).value;
271: if (obj instanceof Bignum)
272: return rational().isEqualTo(obj);
273: if (obj instanceof Ratio)
274: return rational().isEqualTo(obj);
275: if (obj instanceof Complex)
276: return obj.isEqualTo(this );
277: signal(new TypeError(obj, Symbol.NUMBER));
278: // Not reached.
279: return false;
280: }
281:
282: public boolean isNotEqualTo(LispObject obj)
283: throws ConditionThrowable {
284: return !isEqualTo(obj);
285: }
286:
287: public boolean isLessThan(LispObject obj) throws ConditionThrowable {
288: if (obj instanceof LispFloat)
289: return value < ((LispFloat) obj).value;
290: if (obj instanceof Fixnum)
291: return value < ((Fixnum) obj).value;
292: if (obj instanceof Bignum)
293: return rational().isLessThan(obj);
294: if (obj instanceof Ratio)
295: return rational().isLessThan(obj);
296: signal(new TypeError(obj, Symbol.REAL));
297: // Not reached.
298: return false;
299: }
300:
301: public boolean isGreaterThan(LispObject obj)
302: throws ConditionThrowable {
303: if (obj instanceof LispFloat)
304: return value > ((LispFloat) obj).value;
305: if (obj instanceof Fixnum)
306: return value > ((Fixnum) obj).value;
307: if (obj instanceof Bignum)
308: return rational().isGreaterThan(obj);
309: if (obj instanceof Ratio)
310: return rational().isGreaterThan(obj);
311: signal(new TypeError(obj, Symbol.REAL));
312: // Not reached.
313: return false;
314: }
315:
316: public boolean isLessThanOrEqualTo(LispObject obj)
317: throws ConditionThrowable {
318: if (obj instanceof LispFloat)
319: return value <= ((LispFloat) obj).value;
320: if (obj instanceof Fixnum)
321: return value <= ((Fixnum) obj).value;
322: if (obj instanceof Bignum)
323: return rational().isLessThanOrEqualTo(obj);
324: if (obj instanceof Ratio)
325: return rational().isLessThanOrEqualTo(obj);
326: signal(new TypeError(obj, Symbol.REAL));
327: // Not reached.
328: return false;
329: }
330:
331: public boolean isGreaterThanOrEqualTo(LispObject obj)
332: throws ConditionThrowable {
333: if (obj instanceof LispFloat)
334: return value >= ((LispFloat) obj).value;
335: if (obj instanceof Fixnum)
336: return value >= ((Fixnum) obj).value;
337: if (obj instanceof Bignum)
338: return rational().isGreaterThanOrEqualTo(obj);
339: if (obj instanceof Ratio)
340: return rational().isGreaterThanOrEqualTo(obj);
341: signal(new TypeError(obj, Symbol.REAL));
342: // Not reached.
343: return false;
344: }
345:
346: public LispObject truncate(LispObject obj)
347: throws ConditionThrowable {
348: final LispThread thread = LispThread.currentThread();
349: if (obj instanceof Fixnum) {
350: LispObject rational = rational();
351: LispObject quotient = rational.truncate(obj);
352: thread._values[1] = subtract(quotient); // Remainder.
353: return quotient;
354: }
355: if (obj instanceof LispFloat) {
356: double divisor = ((LispFloat) obj).value;
357: double quotient = value / divisor;
358: if (quotient >= Integer.MIN_VALUE
359: && quotient <= Integer.MAX_VALUE) {
360: int q = (int) quotient;
361: return thread.setValues(new Fixnum(q), new LispFloat(
362: value - q * divisor));
363: }
364: // We need to convert the quotient to a bignum.
365: long bits = Double.doubleToRawLongBits((double) quotient);
366: int s = ((bits >> 63) == 0) ? 1 : -1;
367: int e = (int) ((bits >> 52) & 0x7ffL);
368: long m;
369: if (e == 0)
370: m = (bits & 0xfffffffffffffL) << 1;
371: else
372: m = (bits & 0xfffffffffffffL) | 0x10000000000000L;
373: LispObject significand = number(m);
374: Fixnum exponent = new Fixnum(e - 1075);
375: Fixnum sign = new Fixnum(s);
376: LispObject result = significand;
377: result = result.multiplyBy(Primitives.EXPT.execute(
378: Fixnum.TWO, exponent));
379: result = result.multiplyBy(sign);
380: // Calculate remainder.
381: LispObject product = result.multiplyBy(obj);
382: LispObject remainder = subtract(product);
383: return thread.setValues(result, remainder);
384: }
385: return signal(new LispError(
386: "LispFloat.truncate(): not implemented: "
387: + obj.typeOf().writeToString()));
388: }
389:
390: public LispObject ftruncate(LispObject obj)
391: throws ConditionThrowable {
392: final LispThread thread = LispThread.currentThread();
393: double divisor, quotient, remainder;
394: if (obj instanceof Fixnum) {
395: divisor = ((Fixnum) obj).value;
396: } else if (obj instanceof LispFloat) {
397: divisor = ((LispFloat) obj).value;
398: } else {
399: return signal(new LispError(
400: "LispFloat.ftruncate(): not implemented: "
401: + obj.typeOf().writeToString()));
402: }
403: quotient = value / divisor;
404: remainder = value % divisor;
405: if (quotient == 0 || quotient == Double.POSITIVE_INFINITY
406: || quotient == Double.NEGATIVE_INFINITY) {
407: return thread.setValues(new LispFloat(quotient),
408: new LispFloat(remainder));
409: }
410: if (quotient == remainder) {
411: // "The quotient represents the mathematical integer of the
412: // same sign as the mathematical quotient, and that has the
413: // greatest integral magnitude not greater than that of the
414: // mathematical quotient."
415: return thread.setValues(new LispFloat(quotient < 0 ? -0.0
416: : 0.0), new LispFloat(remainder));
417: }
418: return thread.setValues(new LispFloat(quotient - remainder),
419: new LispFloat(remainder));
420: }
421:
422: public int hashCode() {
423: long bits = Double.doubleToLongBits(value);
424: return (int) (bits ^ (bits >>> 32));
425: }
426:
427: public int psxhash() throws ConditionThrowable {
428: if ((value % 1) == 0)
429: return (((int) value) & 0x7fffffff);
430: else
431: return (hashCode() & 0x7fffffff);
432: }
433:
434: public String writeToString() throws ConditionThrowable {
435: if (value == Double.POSITIVE_INFINITY) {
436: StringBuffer sb = new StringBuffer("#.");
437: sb.append(Symbol.DOUBLE_FLOAT_POSITIVE_INFINITY
438: .writeToString());
439: return sb.toString();
440: }
441: if (value == Double.NEGATIVE_INFINITY) {
442: StringBuffer sb = new StringBuffer("#.");
443: sb.append(Symbol.DOUBLE_FLOAT_NEGATIVE_INFINITY
444: .writeToString());
445: return sb.toString();
446: }
447: if (value != value)
448: return "#<DOUBLE-FLOAT NaN>";
449: String s1 = String.valueOf(value);
450: String s2 = s1.replace('E', 'd');
451: if (s1 != s2 || _PRINT_READABLY_.symbolValue() == NIL)
452: return s2;
453: return s2.concat("d0");
454: }
455:
456: // ### integer-decode-float
457: // integer-decode-float float => significand, exponent, integer-sign
458: private static final Primitive1 INTEGER_DECODE_FLOAT = new Primitive1(
459: "integer-decode-float", "float") {
460: public LispObject execute(LispObject arg)
461: throws ConditionThrowable {
462: if (arg instanceof LispFloat) {
463: LispObject[] values = new LispObject[3];
464: long bits = Double
465: .doubleToRawLongBits((double) ((LispFloat) arg).value);
466: int s = ((bits >> 63) == 0) ? 1 : -1;
467: int e = (int) ((bits >> 52) & 0x7ffL);
468: long m;
469: if (e == 0)
470: m = (bits & 0xfffffffffffffL) << 1;
471: else
472: m = (bits & 0xfffffffffffffL) | 0x10000000000000L;
473: LispObject significand = number(m);
474: Fixnum exponent = new Fixnum(e - 1075);
475: Fixnum sign = new Fixnum(s);
476: return LispThread.currentThread().setValues(
477: significand, exponent, sign);
478: }
479: return signal(new TypeError(arg, Symbol.FLOAT));
480: }
481: };
482:
483: public LispObject rational() throws ConditionThrowable {
484: final long bits = Double.doubleToRawLongBits(value);
485: int sign = ((bits >> 63) == 0) ? 1 : -1;
486: int storedExponent = (int) ((bits >> 52) & 0x7ffL);
487: long mantissa;
488: if (storedExponent == 0)
489: mantissa = (bits & 0xfffffffffffffL) << 1;
490: else
491: mantissa = (bits & 0xfffffffffffffL) | 0x10000000000000L;
492: if (mantissa == 0)
493: return Fixnum.ZERO;
494: if (sign < 0)
495: mantissa = -mantissa;
496: // Subtract bias.
497: final int exponent = storedExponent - 1023;
498: BigInteger numerator, denominator;
499: if (exponent < 0) {
500: numerator = BigInteger.valueOf(mantissa);
501: denominator = BigInteger.valueOf(1)
502: .shiftLeft(52 - exponent);
503: } else {
504: numerator = BigInteger.valueOf(mantissa)
505: .shiftLeft(exponent);
506: denominator = BigInteger.valueOf(0x10000000000000L); // (ash 1 52)
507: }
508: return number(numerator, denominator);
509: }
510:
511: // ### rational
512: private static final Primitive1 RATIONAL = new Primitive1(
513: "rational", "number") {
514: public LispObject execute(LispObject arg)
515: throws ConditionThrowable {
516: if (arg instanceof LispFloat)
517: return ((LispFloat) arg).rational();
518: if (arg.rationalp())
519: return arg;
520: return signal(new TypeError(arg, Symbol.REAL));
521: }
522: };
523:
524: // ### float-radix
525: // float-radix float => float-radix
526: private static final Primitive1 FLOAT_RADIX = new Primitive1(
527: "float-radix", "float") {
528: public LispObject execute(LispObject arg)
529: throws ConditionThrowable {
530: if (arg instanceof LispFloat)
531: return Fixnum.TWO;
532: return signal(new TypeError(arg, Symbol.FLOAT));
533: }
534: };
535:
536: private static final Fixnum FIXNUM_53 = new Fixnum(53);
537:
538: // ### float-digits
539: // float-digits float => float-digits
540: private static final Primitive1 FLOAT_DIGITS = new Primitive1(
541: "float-digits", "float") {
542: public LispObject execute(LispObject arg)
543: throws ConditionThrowable {
544: if (arg instanceof LispFloat)
545: return FIXNUM_53;
546: return signal(new TypeError(arg, Symbol.FLOAT));
547: }
548: };
549:
550: // ### scale-float float integer => scaled-float
551: private static final Primitive2 SCALE_FLOAT = new Primitive2(
552: "scale-float", "float integer") {
553: public LispObject execute(LispObject first, LispObject second)
554: throws ConditionThrowable {
555: double f = getValue(first);
556: int n = Fixnum.getValue(second);
557: return new LispFloat(f * Math.pow(2, n));
558: }
559: };
560:
561: public static LispFloat coerceToFloat(LispObject obj)
562: throws ConditionThrowable {
563: if (obj instanceof LispFloat)
564: return (LispFloat) obj;
565: if (obj instanceof Fixnum)
566: return new LispFloat(((Fixnum) obj).value);
567: if (obj instanceof Bignum)
568: return new LispFloat(((Bignum) obj).floatValue());
569: if (obj instanceof Ratio)
570: return new LispFloat(((Ratio) obj).floatValue());
571: signal(new TypeError(obj.writeToString()
572: + " cannot be converted to type FLOAT."));
573: // Not reached.
574: return null;
575: }
576:
577: // ### coerce-to-float
578: private static final Primitive1 COERCE_TO_FLOAT = new Primitive1(
579: "coerce-to-float", PACKAGE_SYS, false) {
580: public LispObject execute(LispObject arg)
581: throws ConditionThrowable {
582: return coerceToFloat(arg);
583: }
584: };
585:
586: // ### float
587: // float number &optional prototype => float
588: private static final Primitive FLOAT = new Primitive("float",
589: "number &optional prototype") {
590: public LispObject execute(LispObject[] args)
591: throws ConditionThrowable {
592: final int length = args.length;
593: if (length < 1 || length > 2)
594: return signal(new WrongNumberOfArgumentsException(this ));
595: // FIXME Ignore prototype (args[1] if present).
596: return coerceToFloat(args[0]);
597: }
598: };
599:
600: // ### floatp
601: // floatp object => generalized-boolean
602: private static final Primitive1 FLOATP = new Primitive1("floatp",
603: "object") {
604: public LispObject execute(LispObject arg)
605: throws ConditionThrowable {
606: return arg instanceof LispFloat ? T : NIL;
607: }
608: };
609:
610: // ### double-float-high-bits
611: private static final Primitive1 DOUBLE_FLOAT_HIGH_BITS = new Primitive1(
612: "double-float-high-bits", PACKAGE_SYS, false, "float") {
613: public LispObject execute(LispObject arg)
614: throws ConditionThrowable {
615: if (arg instanceof LispFloat) {
616: LispFloat f = (LispFloat) arg;
617: return number(Double.doubleToLongBits(f.value) >>> 32);
618: }
619: return signal(new TypeError(arg, Symbol.FLOAT));
620: }
621: };
622:
623: // ### double-float-low-bits
624: private static final Primitive1 DOUBLE_FLOAT_LOW_BITS = new Primitive1(
625: "double-float-low-bits", PACKAGE_SYS, false, "float") {
626: public LispObject execute(LispObject arg)
627: throws ConditionThrowable {
628: if (arg instanceof LispFloat) {
629: LispFloat f = (LispFloat) arg;
630: return number(Double.doubleToLongBits(f.value) & 0xffffffffL);
631: }
632: return signal(new TypeError(arg, Symbol.FLOAT));
633: }
634: };
635:
636: // ### make-double-float bits => float
637: private static final Primitive MAKE_DOUBLE_FLOAT = new Primitive(
638: "make-double-float", PACKAGE_SYS, false, "bits") {
639: public LispObject execute(LispObject arg)
640: throws ConditionThrowable {
641: if (arg instanceof Fixnum) {
642: long bits = (long) ((Fixnum) arg).value;
643: return new LispFloat(Double.longBitsToDouble(bits));
644: }
645: if (arg instanceof Bignum) {
646: long bits = ((Bignum) arg).value.longValue();
647: return new LispFloat(Double.longBitsToDouble(bits));
648: }
649: return signal(new TypeError());
650: }
651: };
652:
653: private static final Primitive1 FLOAT_INFINITY_P = new Primitive1(
654: "float-infinity-p", PACKAGE_SYS, false) {
655: public LispObject execute(LispObject arg)
656: throws ConditionThrowable {
657: if (arg instanceof LispFloat)
658: return Double.isInfinite(((LispFloat) arg).value) ? T
659: : NIL;
660: return signal(new TypeError(arg, Symbol.FLOAT));
661: }
662: };
663:
664: private static final Primitive1 FLOAT_NAN_P = new Primitive1(
665: "float-nan-p", PACKAGE_SYS, false) {
666: public LispObject execute(LispObject arg)
667: throws ConditionThrowable {
668: if (arg instanceof LispFloat)
669: return Double.isNaN(((LispFloat) arg).value) ? T : NIL;
670: return signal(new TypeError(arg, Symbol.FLOAT));
671: }
672: };
673: }
|