001: /*
002: * LispFloat.java
003: *
004: * Copyright (C) 2003 Peter Graves
005: * $Id: LispFloat.java,v 1.7 2003/11/15 11:03:32 beedlem 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: public final class LispFloat extends LispObject {
025: public static final LispFloat ZERO = new LispFloat(0);
026: public static final LispFloat ONE = new LispFloat(1);
027:
028: private final double value;
029:
030: public LispFloat(double value) {
031: this .value = value;
032: }
033:
034: public LispObject typeOf() {
035: return Symbol.FLOAT;
036: }
037:
038: public LispClass classOf() {
039: return BuiltInClass.FLOAT;
040: }
041:
042: public LispObject typep(LispObject typeSpecifier)
043: throws ConditionThrowable {
044: if (typeSpecifier == Symbol.FLOAT)
045: return T;
046: if (typeSpecifier == BuiltInClass.FLOAT)
047: return T;
048: if (typeSpecifier == Symbol.REAL)
049: return T;
050: if (typeSpecifier == Symbol.NUMBER)
051: return T;
052: if (typeSpecifier == Symbol.SINGLE_FLOAT)
053: return T;
054: if (typeSpecifier == Symbol.DOUBLE_FLOAT)
055: return T;
056: if (typeSpecifier == Symbol.SHORT_FLOAT)
057: return T;
058: if (typeSpecifier == Symbol.LONG_FLOAT)
059: return T;
060: return super .typep(typeSpecifier);
061: }
062:
063: public LispObject NUMBERP() {
064: return T;
065: }
066:
067: public boolean numberp() {
068: return true;
069: }
070:
071: public boolean realp() {
072: return true;
073: }
074:
075: public boolean eql(LispObject obj) {
076: if (this == obj)
077: return true;
078: if (obj instanceof LispFloat) {
079: if (value == ((LispFloat) obj).value)
080: return true;
081: }
082: return false;
083: }
084:
085: public boolean equal(LispObject obj) {
086: if (this == obj)
087: return true;
088: if (obj instanceof LispFloat) {
089: if (value == ((LispFloat) obj).value)
090: return true;
091: }
092: return false;
093: }
094:
095: public boolean equalp(LispObject obj) throws ConditionThrowable {
096: if (obj instanceof LispFloat)
097: return value == ((LispFloat) obj).value;
098: if (obj instanceof Fixnum)
099: return value == ((Fixnum) obj).getValue();
100: if (obj instanceof Bignum)
101: return value == ((Bignum) obj).floatValue();
102: if (obj instanceof Ratio)
103: return value == ((Ratio) obj).floatValue();
104: return false;
105: }
106:
107: public LispObject ABS() {
108: if (value >= 0)
109: return this ;
110: return new LispFloat(-value);
111: }
112:
113: public boolean plusp() {
114: return value > 0;
115: }
116:
117: public boolean minusp() {
118: return value < 0;
119: }
120:
121: public boolean zerop() {
122: return value == 0;
123: }
124:
125: public LispObject FLOATP() {
126: return T;
127: }
128:
129: public boolean floatp() {
130: return true;
131: }
132:
133: public static double getValue(LispObject obj)
134: throws ConditionThrowable {
135: try {
136: return ((LispFloat) obj).value;
137: } catch (ClassCastException e) {
138: throw new ConditionThrowable(new TypeError(obj, "float"));
139: }
140: }
141:
142: public final double getValue() {
143: return value;
144: }
145:
146: public Object javaInstance() {
147: return new Double(value);
148: }
149:
150: public final LispObject incr() {
151: return new LispFloat(value + 1);
152: }
153:
154: public final LispObject decr() {
155: return new LispFloat(value - 1);
156: }
157:
158: public LispObject add(LispObject obj) throws ConditionThrowable {
159: if (obj instanceof LispFloat)
160: return new LispFloat(value + ((LispFloat) obj).value);
161: if (obj instanceof Fixnum)
162: return new LispFloat(value + ((Fixnum) obj).getValue());
163: if (obj instanceof Bignum)
164: return new LispFloat(value + ((Bignum) obj).floatValue());
165: if (obj instanceof Ratio)
166: return new LispFloat(value + ((Ratio) obj).floatValue());
167: if (obj instanceof Complex) {
168: Complex c = (Complex) obj;
169: return Complex.getInstance(add(c.getRealPart()), c
170: .getImaginaryPart());
171: }
172: throw new ConditionThrowable(new TypeError(obj, "number"));
173: }
174:
175: public LispObject subtract(LispObject obj)
176: throws ConditionThrowable {
177: if (obj instanceof LispFloat)
178: return new LispFloat(value - ((LispFloat) obj).value);
179: if (obj instanceof Fixnum)
180: return new LispFloat(value - ((Fixnum) obj).getValue());
181: if (obj instanceof Bignum)
182: return new LispFloat(value - ((Bignum) obj).floatValue());
183: if (obj instanceof Ratio)
184: return new LispFloat(value - ((Ratio) obj).floatValue());
185: if (obj instanceof Complex) {
186: Complex c = (Complex) obj;
187: return Complex.getInstance(subtract(c.getRealPart()), ZERO
188: .subtract(c.getImaginaryPart()));
189: }
190: throw new ConditionThrowable(new TypeError(obj, "number"));
191: }
192:
193: public LispObject multiplyBy(LispObject obj)
194: throws ConditionThrowable {
195: if (obj instanceof LispFloat)
196: return new LispFloat(value * ((LispFloat) obj).value);
197: if (obj instanceof Fixnum)
198: return new LispFloat(value * ((Fixnum) obj).getValue());
199: if (obj instanceof Bignum)
200: return new LispFloat(value * ((Bignum) obj).floatValue());
201: if (obj instanceof Ratio)
202: return new LispFloat(value * ((Ratio) obj).floatValue());
203: throw new ConditionThrowable(new TypeError(obj, "number"));
204: }
205:
206: public LispObject divideBy(LispObject obj)
207: throws ConditionThrowable {
208: if (obj.zerop())
209: throw new ConditionThrowable(new DivisionByZero());
210: if (obj instanceof LispFloat)
211: return new LispFloat(value / ((LispFloat) obj).value);
212: if (obj instanceof Fixnum)
213: return new LispFloat(value / ((Fixnum) obj).getValue());
214: if (obj instanceof Bignum)
215: return new LispFloat(value / ((Bignum) obj).floatValue());
216: if (obj instanceof Ratio)
217: return new LispFloat(value / ((Ratio) obj).floatValue());
218: throw new ConditionThrowable(new TypeError(obj, "number"));
219: }
220:
221: public boolean isEqualTo(LispObject obj) throws ConditionThrowable {
222: if (obj instanceof LispFloat)
223: return value == ((LispFloat) obj).value;
224: if (obj instanceof Fixnum)
225: return value == ((Fixnum) obj).getValue();
226: if (obj instanceof Bignum)
227: return value == ((Bignum) obj).floatValue();
228: if (obj instanceof Ratio)
229: return value == ((Ratio) obj).floatValue();
230: if (obj instanceof Complex)
231: return obj.isEqualTo(this );
232: throw new ConditionThrowable(new TypeError(obj, "number"));
233: }
234:
235: public boolean isNotEqualTo(LispObject obj)
236: throws ConditionThrowable {
237: return !isEqualTo(obj);
238: }
239:
240: public boolean isLessThan(LispObject obj) throws ConditionThrowable {
241: if (obj instanceof LispFloat)
242: return value < ((LispFloat) obj).value;
243: if (obj instanceof Fixnum)
244: return value < ((Fixnum) obj).getValue();
245: if (obj instanceof Bignum)
246: return value < ((Bignum) obj).floatValue();
247: if (obj instanceof Ratio)
248: return value < ((Ratio) obj).floatValue();
249: throw new ConditionThrowable(new TypeError(obj, "real"));
250: }
251:
252: public boolean isGreaterThan(LispObject obj)
253: throws ConditionThrowable {
254: if (obj instanceof LispFloat)
255: return value > ((LispFloat) obj).value;
256: if (obj instanceof Fixnum)
257: return value > ((Fixnum) obj).getValue();
258: if (obj instanceof Bignum)
259: return value > ((Bignum) obj).floatValue();
260: if (obj instanceof Ratio)
261: return value > ((Ratio) obj).floatValue();
262: throw new ConditionThrowable(new TypeError(obj, "real"));
263: }
264:
265: public boolean isLessThanOrEqualTo(LispObject obj)
266: throws ConditionThrowable {
267: if (obj instanceof LispFloat)
268: return value <= ((LispFloat) obj).value;
269: if (obj instanceof Fixnum)
270: return value <= ((Fixnum) obj).getValue();
271: if (obj instanceof Bignum)
272: return value <= ((Bignum) obj).floatValue();
273: if (obj instanceof Ratio)
274: return value <= ((Ratio) obj).floatValue();
275: throw new ConditionThrowable(new TypeError(obj, "real"));
276: }
277:
278: public boolean isGreaterThanOrEqualTo(LispObject obj)
279: throws ConditionThrowable {
280: if (obj instanceof LispFloat)
281: return value >= ((LispFloat) obj).value;
282: if (obj instanceof Fixnum)
283: return value >= ((Fixnum) obj).getValue();
284: if (obj instanceof Bignum)
285: return value >= ((Bignum) obj).floatValue();
286: if (obj instanceof Ratio)
287: return value >= ((Ratio) obj).floatValue();
288: throw new ConditionThrowable(new TypeError(obj, "real"));
289: }
290:
291: public LispObject truncate(LispObject obj)
292: throws ConditionThrowable {
293: final LispThread thread = LispThread.currentThread();
294: LispObject[] values = new LispObject[2];
295: if (obj instanceof Fixnum) {
296: long divisor = ((Fixnum) obj).getValue();
297: double quotient = value / divisor;
298: double remainder = value % divisor;
299: if (quotient >= Integer.MIN_VALUE
300: && quotient <= Integer.MAX_VALUE) {
301: values[0] = new Fixnum((int) quotient);
302: values[1] = new LispFloat(remainder);
303: thread.setValues(values);
304: return values[0];
305: }
306: }
307: if (obj instanceof LispFloat) {
308: double divisor = ((LispFloat) obj).getValue();
309: double quotient = value / divisor;
310: if (quotient >= Integer.MIN_VALUE
311: && quotient <= Integer.MAX_VALUE) {
312: int q = (int) quotient;
313: values[0] = new Fixnum(q);
314: values[1] = new LispFloat(value - q * divisor);
315: thread.setValues(values);
316: return values[0];
317: }
318: // We need to convert the quotient to a bignum.
319: long bits = Double.doubleToRawLongBits((double) quotient);
320: int s = ((bits >> 63) == 0) ? 1 : -1;
321: int e = (int) ((bits >> 52) & 0x7ffL);
322: long m;
323: if (e == 0)
324: m = (bits & 0xfffffffffffffL) << 1;
325: else
326: m = (bits & 0xfffffffffffffL) | 0x10000000000000L;
327: LispObject significand = number(m);
328: Fixnum exponent = new Fixnum(e - 1075);
329: Fixnum sign = new Fixnum(s);
330: LispObject result = significand;
331: result = result.multiplyBy(Primitives.EXPT.execute(
332: Fixnum.TWO, exponent));
333: result = result.multiplyBy(sign);
334: // Calculate remainder.
335: LispObject product = result.multiplyBy(obj);
336: LispObject remainder = subtract(product);
337: values[0] = result;
338: values[1] = remainder;
339: thread.setValues(values);
340: return values[0];
341: }
342: throw new ConditionThrowable(new LispError(
343: "LispFloat.truncate(): not implemented: "
344: + obj.typeOf()));
345: }
346:
347: public int hashCode() {
348: long bits = Double.doubleToLongBits(value);
349: return (int) (bits ^ (bits >>> 32));
350: }
351:
352: public String toString() {
353: return String.valueOf(value);
354: }
355:
356: // ### integer-decode-float
357: // integer-decode-float float => significand, exponent, integer-sign
358: private static final Primitive1 INTEGER_DECODE_FLOAT = new Primitive1(
359: "integer-decode-float") {
360: public LispObject execute(LispObject arg)
361: throws ConditionThrowable {
362: if (arg instanceof LispFloat) {
363: LispObject[] values = new LispObject[3];
364: long bits = Double
365: .doubleToRawLongBits((double) ((LispFloat) arg)
366: .getValue());
367: int s = ((bits >> 63) == 0) ? 1 : -1;
368: int e = (int) ((bits >> 52) & 0x7ffL);
369: long m;
370: if (e == 0)
371: m = (bits & 0xfffffffffffffL) << 1;
372: else
373: m = (bits & 0xfffffffffffffL) | 0x10000000000000L;
374: LispObject significand = number(m);
375: Fixnum exponent = new Fixnum(e - 1075);
376: Fixnum sign = new Fixnum(s);
377: values[0] = significand;
378: values[1] = exponent;
379: values[2] = sign;
380: LispThread.currentThread().setValues(values);
381: return values[0];
382: }
383: throw new ConditionThrowable(new TypeError(arg, "float"));
384: }
385: };
386:
387: // ### float-radix
388: // float-radix float => float-radix
389: private static final Primitive1 FLOAT_RADIX = new Primitive1(
390: "float-radix") {
391: public LispObject execute(LispObject arg)
392: throws ConditionThrowable {
393: if (arg instanceof LispFloat)
394: return Fixnum.TWO;
395: throw new ConditionThrowable(new TypeError(arg, "float"));
396: }
397: };
398:
399: // ### float-digits
400: // float-digits float => float-digits
401: private static final Primitive1 FLOAT_DIGITS = new Primitive1(
402: "float-digits") {
403: public LispObject execute(LispObject arg)
404: throws ConditionThrowable {
405: if (arg instanceof LispFloat)
406: return new Fixnum(52);
407: throw new ConditionThrowable(new TypeError(arg, "float"));
408: }
409: };
410:
411: public static LispFloat coerceToFloat(LispObject obj)
412: throws ConditionThrowable {
413: if (obj instanceof LispFloat)
414: return (LispFloat) obj;
415: if (obj instanceof Fixnum)
416: return new LispFloat(((Fixnum) obj).getValue());
417: if (obj instanceof Bignum)
418: return new LispFloat(((Bignum) obj).floatValue());
419: if (obj instanceof Ratio)
420: return new LispFloat(((Ratio) obj).floatValue());
421: throw new ConditionThrowable(new TypeError(obj, "real number"));
422: }
423:
424: // ### float
425: // float number &optional prototype => float
426: private static final Primitive FLOAT = new Primitive("float") {
427: public LispObject execute(LispObject[] args)
428: throws ConditionThrowable {
429: final int length = args.length;
430: if (length < 1 || length > 2)
431: throw new ConditionThrowable(
432: new WrongNumberOfArgumentsException(this ));
433: // FIXME Ignore prototype (args[1] if present).
434: return coerceToFloat(args[0]);
435: }
436: };
437:
438: // ### floatp
439: // floatp object => generalized-boolean
440: private static final Primitive1 FLOATP = new Primitive1("floatp") {
441: public LispObject execute(LispObject arg)
442: throws ConditionThrowable {
443: return arg.FLOATP();
444: }
445: };
446: }
|