|
1
21
22 package org.armedbear.lisp;
23
24 import java.math.BigInteger  ;
25
26 public final class LispFloat extends LispObject
27 {
28 public static final LispFloat ZERO = new LispFloat(0);
29 public static final LispFloat ONE = new LispFloat(1);
30 public static final LispFloat MINUS_ONE = new LispFloat(-1);
31
32 public static final LispFloat PI =
33 new LispFloat((double)3.141592653589793);
34
35 public static final LispFloat DOUBLE_FLOAT_POSITIVE_INFINITY =
36 new LispFloat(Double.POSITIVE_INFINITY);
37
38 public static final LispFloat DOUBLE_FLOAT_NEGATIVE_INFINITY =
39 new LispFloat(Double.NEGATIVE_INFINITY);
40
41 static {
42 Symbol.DOUBLE_FLOAT_POSITIVE_INFINITY.setSymbolValue(DOUBLE_FLOAT_POSITIVE_INFINITY);
43 Symbol.DOUBLE_FLOAT_POSITIVE_INFINITY.setConstant(true);
44 Symbol.DOUBLE_FLOAT_NEGATIVE_INFINITY.setSymbolValue(DOUBLE_FLOAT_NEGATIVE_INFINITY);
45 Symbol.DOUBLE_FLOAT_NEGATIVE_INFINITY.setConstant(true);
46 }
47
48 public final double value;
49
50 public LispFloat(double value)
51 {
52 this.value = value;
53 }
54
55 public LispObject typeOf()
56 {
57 return Symbol.FLOAT;
58 }
59
60 public LispClass classOf()
61 {
62 return BuiltInClass.FLOAT;
63 }
64
65 public LispObject typep(LispObject typeSpecifier) throws ConditionThrowable
66 {
67 if (typeSpecifier == Symbol.FLOAT)
68 return T;
69 if (typeSpecifier == BuiltInClass.FLOAT)
70 return T;
71 if (typeSpecifier == Symbol.REAL)
72 return T;
73 if (typeSpecifier == Symbol.NUMBER)
74 return T;
75 if (typeSpecifier == Symbol.SINGLE_FLOAT)
76 return T;
77 if (typeSpecifier == Symbol.DOUBLE_FLOAT)
78 return T;
79 if (typeSpecifier == Symbol.SHORT_FLOAT)
80 return T;
81 if (typeSpecifier == Symbol.LONG_FLOAT)
82 return T;
83 return super.typep(typeSpecifier);
84 }
85
86 public LispObject NUMBERP()
87 {
88 return T;
89 }
90
91 public boolean numberp()
92 {
93 return true;
94 }
95
96 public boolean realp()
97 {
98 return true;
99 }
100
101 public boolean eql(LispObject obj)
102 {
103 if (this == obj)
104 return true;
105 if (obj instanceof LispFloat) {
106 if (value == ((LispFloat)obj).value)
107 return true;
108 }
109 return false;
110 }
111
112 public boolean equal(LispObject obj)
113 {
114 if (this == obj)
115 return true;
116 if (obj instanceof LispFloat) {
117 if (value == ((LispFloat)obj).value)
118 return true;
119 }
120 return false;
121 }
122
123 public boolean equalp(LispObject obj) throws ConditionThrowable
124 {
125 if (obj instanceof LispFloat)
126 return value == ((LispFloat)obj).value;
127 if (obj instanceof Fixnum)
128 return value == ((Fixnum)obj).getValue();
129 if (obj instanceof Bignum)
130 return value == ((Bignum)obj).floatValue();
131 if (obj instanceof Ratio)
132 return value == ((Ratio)obj).floatValue();
133 return false;
134 }
135
136 public LispObject ABS()
137 {
138 if (value > 0)
139 return this;
140 if (value == 0) return LispFloat.ZERO;
142 return new LispFloat(- value);
143 }
144
145 public boolean plusp()
146 {
147 return value > 0;
148 }
149
150 public boolean minusp()
151 {
152 return value < 0;
153 }
154
155 public boolean zerop()
156 {
157 return value == 0;
158 }
159
160 public LispObject FLOATP()
161 {
162 return T;
163 }
164
165 public boolean floatp()
166 {
167 return true;
168 }
169
170 public static double getValue(LispObject obj) throws ConditionThrowable
171 {
172 try {
173 return ((LispFloat)obj).value;
174 }
175 catch (ClassCastException e) {
176 signal(new TypeError(obj, Symbol.FLOAT));
177 return 0;
179 }
180 }
181
182 public final double getValue()
183 {
184 return value;
185 }
186
187 public Object javaInstance()
188 {
189 return new Double (value);
190 }
191
192 public Object javaInstance(Class c)
193 {
194 String cn = c.getName();
195 if (cn.equals("java.lang.Float") || cn.equals("float"))
196 return new Float (value);
197 return javaInstance();
198 }
199
200 public final LispObject incr()
201 {
202 return new LispFloat(value + 1);
203 }
204
205 public final LispObject decr()
206 {
207 return new LispFloat(value - 1);
208 }
209
210 public LispObject add(LispObject obj) throws ConditionThrowable
211 {
212 if (obj instanceof LispFloat)
213 return new LispFloat(value + ((LispFloat)obj).value);
214 if (obj instanceof Fixnum)
215 return new LispFloat(value + ((Fixnum)obj).value);
216 if (obj instanceof Bignum)
217 return new LispFloat(value + ((Bignum)obj).floatValue());
218 if (obj instanceof Ratio)
219 return new LispFloat(value + ((Ratio)obj).floatValue());
220 if (obj instanceof Complex) {
221 Complex c = (Complex) obj;
222 return Complex.getInstance(add(c.getRealPart()), c.getImaginaryPart());
223 }
224 return signal(new TypeError(obj, Symbol.NUMBER));
225 }
226
227 public LispObject subtract(LispObject obj) throws ConditionThrowable
228 {
229 if (obj instanceof LispFloat)
230 return new LispFloat(value - ((LispFloat)obj).value);
231 if (obj instanceof Fixnum)
232 return new LispFloat(value - ((Fixnum)obj).value);
233 if (obj instanceof Bignum)
234 return new LispFloat(value - ((Bignum)obj).floatValue());
235 if (obj instanceof Ratio)
236 return new LispFloat(value - ((Ratio)obj).floatValue());
237 if (obj instanceof Complex) {
238 Complex c = (Complex) obj;
239 return Complex.getInstance(subtract(c.getRealPart()),
240 ZERO.subtract(c.getImaginaryPart()));
241 }
242 return signal(new TypeError(obj, Symbol.NUMBER));
243 }
244
245 public LispObject multiplyBy(LispObject obj) throws ConditionThrowable
246 {
247 if (obj instanceof LispFloat)
248 return new LispFloat(value * ((LispFloat)obj).value);
249 if (obj instanceof Fixnum)
250 return new LispFloat(value * ((Fixnum)obj).value);
251 if (obj instanceof Bignum)
252 return new LispFloat(value * ((Bignum)obj).floatValue());
253 if (obj instanceof Ratio)
254 return new LispFloat(value * ((Ratio)obj).floatValue());
255 if (obj instanceof Complex) {
256 Complex c = (Complex) obj;
257 return Complex.getInstance(multiplyBy(c.getRealPart()),
258 multiplyBy(c.getImaginaryPart()));
259 }
260 return signal(new TypeError(obj, Symbol.NUMBER));
261 }
262
263 public LispObject divideBy(LispObject obj) throws ConditionThrowable
264 {
265 if (obj instanceof LispFloat)
266 return new LispFloat(value / ((LispFloat)obj).value);
267 if (obj instanceof Fixnum)
268 return new LispFloat(value / ((Fixnum)obj).value);
269 if (obj instanceof Bignum)
270 return new LispFloat(value / ((Bignum)obj).floatValue());
271 if (obj instanceof Ratio)
272 return new LispFloat(value / ((Ratio)obj).floatValue());
273 if (obj instanceof Complex) {
274 Complex c = (Complex) obj;
275 LispObject re = c.getRealPart();
276 LispObject im = c.getImaginaryPart();
277 LispObject denom = re.multiplyBy(re).add(im.multiplyBy(im));
278 LispObject resX = multiplyBy(re).divideBy(denom);
279 LispObject resY =
280 multiplyBy(Fixnum.MINUS_ONE).multiplyBy(im).divideBy(denom);
281 return Complex.getInstance(resX, resY);
282 }
283 return signal(new TypeError(obj, Symbol.NUMBER));
284 }
285
286 public boolean isEqualTo(LispObject obj) throws ConditionThrowable
287 {
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().isEqualTo(obj);
294 if (obj instanceof Ratio)
295 return rational().isEqualTo(obj);
296 if (obj instanceof Complex)
297 return obj.isEqualTo(this);
298 signal(new TypeError(obj, Symbol.NUMBER));
299 return false;
301 }
302
303 public boolean isNotEqualTo(LispObject obj) throws ConditionThrowable
304 {
305 return !isEqualTo(obj);
306 }
307
308 public boolean isLessThan(LispObject obj) throws ConditionThrowable
309 {
310 if (obj instanceof LispFloat)
311 return value < ((LispFloat)obj).value;
312 if (obj instanceof Fixnum)
313 return value < ((Fixnum)obj).value;
314 if (obj instanceof Bignum)
315 return rational().isLessThan(obj);
316 if (obj instanceof Ratio)
317 return rational().isLessThan(obj);
318 signal(new TypeError(obj, Symbol.REAL));
319 return false;
321 }
322
323 public boolean isGreaterThan(LispObject obj) throws ConditionThrowable
324 {
325 if (obj instanceof LispFloat)
326 return value > ((LispFloat)obj).value;
327 if (obj instanceof Fixnum)
328 return value > ((Fixnum)obj).value;
329 if (obj instanceof Bignum)
330 return rational().isGreaterThan(obj);
331 if (obj instanceof Ratio)
332 return rational().isGreaterThan(obj);
333 signal(new TypeError(obj, Symbol.REAL));
334 return false;
336 }
337
338 public boolean isLessThanOrEqualTo(LispObject obj) throws ConditionThrowable
339 {
340 if (obj instanceof LispFloat)
341 return value <= ((LispFloat)obj).value;
342 if (obj instanceof Fixnum)
343 return value <= ((Fixnum)obj).value;
344 if (obj instanceof Bignum)
345 return rational().isLessThanOrEqualTo(obj);
346 if (obj instanceof Ratio)
347 return rational().isLessThanOrEqualTo(obj);
348 signal(new TypeError(obj, Symbol.REAL));
349 return false;
351 }
352
353 public boolean isGreaterThanOrEqualTo(LispObject obj) throws ConditionThrowable
354 {
355 if (obj instanceof LispFloat)
356 return value >= ((LispFloat)obj).value;
357 if (obj instanceof Fixnum)
358 return value >= ((Fixnum)obj).value;
359 if (obj instanceof Bignum)
360 return rational().isGreaterThanOrEqualTo(obj);
361 if (obj instanceof Ratio)
362 return rational().isGreaterThanOrEqualTo(obj);
363 signal(new TypeError(obj, Symbol.REAL));
364 return false;
366 }
367
368 public LispObject truncate(LispObject obj) throws ConditionThrowable
369 {
370 final LispThread thread = LispThread.currentThread();
371 if (obj instanceof Fixnum) {
372 LispObject rational = rational();
373 LispObject quotient = rational.truncate(obj);
374 thread._values[1] = subtract(quotient); return quotient;
376 }
377 if (obj instanceof LispFloat) {
378 double divisor = ((LispFloat)obj).value;
379 double quotient = value / divisor;
380 if (quotient >= Integer.MIN_VALUE && quotient <= Integer.MAX_VALUE) {
381 int q = (int) quotient;
382 return thread.setValues(new Fixnum(q),
383 new LispFloat(value - q * divisor));
384 }
385 long bits = Double.doubleToRawLongBits((double)quotient);
387 int s = ((bits >> 63) == 0) ? 1 : -1;
388 int e = (int) ((bits >> 52) & 0x7ffL);
389 long m;
390 if (e == 0)
391 m = (bits & 0xfffffffffffffL) << 1;
392 else
393 m = (bits & 0xfffffffffffffL) | 0x10000000000000L;
394 LispObject significand = number(m);
395 Fixnum exponent = new Fixnum(e - 1075);
396 Fixnum sign = new Fixnum(s);
397 LispObject result = significand;
398 result =
399 result.multiplyBy(Primitives.EXPT.execute(Fixnum.TWO, exponent));
400 result = result.multiplyBy(sign);
401 LispObject product = result.multiplyBy(obj);
403 LispObject remainder = subtract(product);
404 return thread.setValues(result, remainder);
405 }
406 return signal(new LispError("LispFloat.truncate(): not implemented: " +
407 obj.typeOf().writeToString()));
408 }
409
410 public LispObject ftruncate(LispObject obj) throws ConditionThrowable
411 {
412 final LispThread thread = LispThread.currentThread();
413 double divisor, quotient, remainder;
414 if (obj instanceof Fixnum) {
415 divisor = ((Fixnum)obj).value;
416 } else if (obj instanceof LispFloat) {
417 divisor = ((LispFloat)obj).value;
418 } else {
419 return signal(new LispError("LispFloat.ftruncate(): not implemented: " +
420 obj.typeOf().writeToString()));
421 }
422 quotient = value / divisor;
423 remainder = value % divisor;
424 if (quotient == 0 ||
425 quotient == Double.POSITIVE_INFINITY ||
426 quotient == Double.NEGATIVE_INFINITY)
427 {
428 return thread.setValues(new LispFloat(quotient),
429 new LispFloat(remainder));
430 }
431 if (quotient == remainder) {
432 return thread.setValues(new LispFloat(quotient < 0 ? -0.0 : 0.0),
437 new LispFloat(remainder));
438 }
439 return thread.setValues(new LispFloat(quotient - remainder),
440 new LispFloat(remainder));
441 }
442
443 public int hashCode()
444 {
445 long bits = Double.doubleToLongBits(value);
446 return (int) (bits ^ (bits >>> 32));
447 }
448
449 public int psxhash() throws ConditionThrowable
450 {
451 if ((value % 1) == 0)
452 return (((int)value) & 0x7fffffff);
453 else
454 return (hashCode() & 0x7fffffff);
455 }
456
457 public String writeToString() throws ConditionThrowable
458 {
459 if (value == Double.POSITIVE_INFINITY) {
460 StringBuffer sb = new StringBuffer ("#.");
461 sb.append(Symbol.DOUBLE_FLOAT_POSITIVE_INFINITY.writeToString());
462 return sb.toString();
463 }
464 if (value == Double.NEGATIVE_INFINITY) {
465 StringBuffer sb = new StringBuffer ("#.");
466 sb.append(Symbol.DOUBLE_FLOAT_NEGATIVE_INFINITY.writeToString());
467 return sb.toString();
468 }
469 if (value != value)
470 return "#<DOUBLE-FLOAT NaN>";
471 String s1 = String.valueOf(value);
472 String s2 = s1.replace('E', 'd');
473 if (s1 != s2 || _PRINT_READABLY_.symbolValue() == NIL)
474 return s2;
475 return s2.concat("d0");
476 }
477
478 private static final Primitive1 INTEGER_DECODE_FLOAT =
481 new Primitive1("integer-decode-float", "float")
482 {
483 public LispObject execute(LispObject arg) throws ConditionThrowable
484 {
485 if (arg instanceof LispFloat) {
486 LispObject[] values = new LispObject[3];
487 long bits =
488 Double.doubleToRawLongBits((double)((LispFloat)arg).value);
489 int s = ((bits >> 63) == 0) ? 1 : -1;
490 int e = (int) ((bits >> 52) & 0x7ffL);
491 long m;
492 if (e == 0)
493 m = (bits & 0xfffffffffffffL) << 1;
494 else
495 m = (bits & 0xfffffffffffffL) | 0x10000000000000L;
496 LispObject significand = number(m);
497 Fixnum exponent = new Fixnum(e - 1075);
498 Fixnum sign = new Fixnum(s);
499 return LispThread.currentThread().setValues(significand,
500 exponent,
501 sign);
502 }
503 return signal(new TypeError(arg, Symbol.FLOAT));
504 }
505 };
506
507 public LispObject rational() throws ConditionThrowable
508 {
509 final long bits = Double.doubleToRawLongBits(value);
510 int sign = ((bits >> 63) == 0) ? 1 : -1;
511 int storedExponent = (int) ((bits >> 52) & 0x7ffL);
512 long mantissa;
513 if (storedExponent == 0)
514 mantissa = (bits & 0xfffffffffffffL) << 1;
515 else
516 mantissa = (bits & 0xfffffffffffffL) | 0x10000000000000L;
517 if (mantissa == 0)
518 return Fixnum.ZERO;
519 if (sign < 0)
520 mantissa = -mantissa;
521 final int exponent = storedExponent - 1023;
523 BigInteger numerator, denominator;
524 if (exponent < 0) {
525 numerator = BigInteger.valueOf(mantissa);
526 denominator = BigInteger.valueOf(1).shiftLeft(52 - exponent);
527 } else {
528 numerator = BigInteger.valueOf(mantissa).shiftLeft(exponent);
529 denominator = BigInteger.valueOf(0x10000000000000L); }
531 return number(numerator, denominator);
532 }
533
534 private static final Primitive1 RATIONAL =
536 new Primitive1("rational", "number")
537 {
538 public LispObject execute(LispObject arg) throws ConditionThrowable
539 {
540 if (arg instanceof LispFloat)
541 return ((LispFloat)arg).rational();
542 if (arg.rationalp())
543 return arg;
544 return signal(new TypeError(arg, Symbol.REAL));
545 }
546 };
547
548 private static final Primitive1 FLOAT_RADIX =
551 new Primitive1("float-radix", "float")
552 {
553 public LispObject execute(LispObject arg) throws ConditionThrowable
554 {
555 if (arg instanceof LispFloat)
556 return Fixnum.TWO;
557 return signal(new TypeError(arg, Symbol.FLOAT));
558 }
559 };
560
561 private static final Fixnum FIXNUM_53 = new Fixnum(53);
562
563 private static final Primitive1 FLOAT_DIGITS =
566 new Primitive1("float-digits", "float")
567 {
568 public LispObject execute(LispObject arg) throws ConditionThrowable
569 {
570 if (arg instanceof LispFloat)
571 return FIXNUM_53;
572 return signal(new TypeError(arg, Symbol.FLOAT));
573 }
574 };
575
576 private static final Primitive2 SCALE_FLOAT =
578 new Primitive2("scale-float", "float integer")
579 {
580 public LispObject execute(LispObject first, LispObject second)
581 throws ConditionThrowable
582 {
583 double f = getValue(first);
584 int n = Fixnum.getValue(second);
585 return new LispFloat(f * Math.pow(2, n));
586 }
587 };
588
589 public static LispFloat coerceToFloat(LispObject obj) throws ConditionThrowable
590 {
591 if (obj instanceof LispFloat)
592 return (LispFloat) obj;
593 if (obj instanceof Fixnum)
594 return new LispFloat(((Fixnum)obj).value);
595 if (obj instanceof Bignum)
596 return new LispFloat(((Bignum)obj).floatValue());
597 if (obj instanceof Ratio)
598 return new LispFloat(((Ratio)obj).floatValue());
599 signal(new TypeError(obj.writeToString() +
600 " cannot be converted to type FLOAT."));
601 return null;
603 }
604
605 private static final Primitive1 COERCE_TO_FLOAT =
607 new Primitive1("coerce-to-float", PACKAGE_SYS, false)
608 {
609 public LispObject execute(LispObject arg) throws ConditionThrowable
610 {
611 return coerceToFloat(arg);
612 }
613 };
614
615 private static final Primitive FLOAT =
618 new Primitive("float", "number &optional prototype")
619 {
620 public LispObject execute(LispObject[] args) throws ConditionThrowable
621 {
622 final int length = args.length;
623 if (length < 1 || length > 2)
624 return signal(new WrongNumberOfArgumentsException(this));
625 return coerceToFloat(args[0]);
627 }
628 };
629
630 private static final Primitive1 FLOATP = new Primitive1("floatp", "object")
633 {
634 public LispObject execute(LispObject arg) throws ConditionThrowable
635 {
636 return arg instanceof LispFloat ? T : NIL;
637 }
638 };
639
640 private static final Primitive1 DOUBLE_FLOAT_HIGH_BITS =
642 new Primitive1("double-float-high-bits", PACKAGE_SYS, false, "float")
643 {
644 public LispObject execute(LispObject arg) throws ConditionThrowable
645 {
646 if (arg instanceof LispFloat) {
647 LispFloat f = (LispFloat) arg;
648 return number(Double.doubleToLongBits(f.value) >>> 32);
649 }
650 return signal(new TypeError(arg, Symbol.FLOAT));
651 }
652 };
653
654 private static final Primitive1 DOUBLE_FLOAT_LOW_BITS =
656 new Primitive1("double-float-low-bits", PACKAGE_SYS, false, "float")
657 {
658 public LispObject execute(LispObject arg) throws ConditionThrowable
659 {
660 if (arg instanceof LispFloat) {
661 LispFloat f = (LispFloat) arg;
662 return number(Double.doubleToLongBits(f.value) & 0xffffffffL);
663 }
664 return signal(new TypeError(arg, Symbol.FLOAT));
665 }
666 };
667
668 private static final Primitive MAKE_DOUBLE_FLOAT =
670 new Primitive("make-double-float", PACKAGE_SYS, false, "bits")
671 {
672 public LispObject execute(LispObject arg)
673 throws ConditionThrowable
674 {
675 if (arg instanceof Fixnum) {
676 long bits = (long) ((Fixnum)arg).value;
677 return new LispFloat(Double.longBitsToDouble(bits));
678 }
679 if (arg instanceof Bignum) {
680 long bits = ((Bignum)arg).value.longValue();
681 return new LispFloat(Double.longBitsToDouble(bits));
682 }
683 return signal(new TypeError());
684 }
685 };
686
687 private static final Primitive1 FLOAT_INFINITY_P =
688 new Primitive1("float-infinity-p", PACKAGE_SYS, false)
689 {
690 public LispObject execute(LispObject arg)
691 throws ConditionThrowable
692 {
693 if (arg instanceof LispFloat)
694 return Double.isInfinite(((LispFloat)arg).value) ? T : NIL;
695 return signal(new TypeError(arg, Symbol.FLOAT));
696 }
697 };
698
699 private static final Primitive1 FLOAT_NAN_P =
700 new Primitive1("float-nan-p", PACKAGE_SYS, false)
701 {
702 public LispObject execute(LispObject arg)
703 throws ConditionThrowable
704 {
705 if (arg instanceof LispFloat)
706 return Double.isNaN(((LispFloat)arg).value) ? T : NIL;
707 return signal(new TypeError(arg, Symbol.FLOAT));
708 }
709 };
710 }
711 |
Popular Tags |
Java API By Example, From Geeks To Geeks.