source: trunk/abcl/src/org/armedbear/lisp/MathFunctions.java @ 12642

Last change on this file since 12642 was 12513, checked in by ehuelsmann, 15 years ago

Remove 'private' keyword to eliminate the Java requirement

for the compiler to generate synthetic accessors: functions that
don't appear in the source but do appear in the class file.

Patch by: Douglas Miles <dmiles _at_ users.sf.net>
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 28.9 KB
Line 
1/*
2 * MathFunctions.java
3 *
4 * Copyright (C) 2004-2006 Peter Graves
5 * $Id: MathFunctions.java 12513 2010-03-02 22:35:36Z ehuelsmann $
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., 59 Temple Place - Suite 330, Boston, MA  02111-1307, 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
38public final class MathFunctions
39{
40    // ### sin
41    private static final Primitive SIN = new Primitive("sin", "radians")
42    {
43        @Override
44        public LispObject execute(LispObject arg)
45        {
46            return sin(arg);
47        }
48    };
49
50    static LispObject sin(LispObject arg)
51    {
52        if (arg instanceof DoubleFloat)
53            return new DoubleFloat(Math.sin(((DoubleFloat)arg).value));
54        if (arg.realp())
55            return new SingleFloat((float)Math.sin(SingleFloat.coerceToFloat(arg).value));
56        if (arg instanceof Complex) {
57            LispObject n = arg.multiplyBy(Complex.getInstance(Fixnum.ZERO,
58                                                              Fixnum.ONE));
59            LispObject result = exp(n);
60            result = result.subtract(exp(n.multiplyBy(Fixnum.MINUS_ONE)));
61            return result.divideBy(Fixnum.TWO.multiplyBy(Complex.getInstance(Fixnum.ZERO,
62                                                                             Fixnum.ONE)));
63        }
64        return type_error(arg, Symbol.NUMBER);
65    }
66
67    // ### cos
68    private static final Primitive COS = new Primitive("cos", "radians")
69    {
70        @Override
71        public LispObject execute(LispObject arg)
72        {
73            return cos(arg);
74        }
75    };
76
77    static LispObject cos(LispObject arg)
78    {
79        if (arg instanceof DoubleFloat)
80            return new DoubleFloat(Math.cos(((DoubleFloat)arg).value));
81        if (arg.realp())
82            return new SingleFloat((float)Math.cos(SingleFloat.coerceToFloat(arg).value));
83        if (arg instanceof Complex) {
84            LispObject n = arg.multiplyBy(Complex.getInstance(Fixnum.ZERO,
85                                                              Fixnum.ONE));
86            LispObject result = exp(n);
87            result = result.add(exp(n.multiplyBy(Fixnum.MINUS_ONE)));
88            return result.divideBy(Fixnum.TWO);
89        }
90        return type_error(arg, Symbol.NUMBER);
91    }
92
93    // ### tan
94    private static final Primitive TAN = new Primitive("tan", "radians")
95    {
96        @Override
97        public LispObject execute(LispObject arg)
98        {
99            if (arg instanceof DoubleFloat)
100                return new DoubleFloat(Math.tan(((DoubleFloat)arg).value));
101            if (arg.realp())
102                return new SingleFloat((float)Math.tan(SingleFloat.coerceToFloat(arg).value));
103            return sin(arg).divideBy(cos(arg));
104        }
105    };
106
107    // ### asin
108    private static final Primitive ASIN = new Primitive("asin", "number")
109    {
110        @Override
111        public LispObject execute(LispObject arg)
112        {
113            return asin(arg);
114        }
115    };
116
117    static LispObject asin(LispObject arg)
118    {
119        if (arg instanceof SingleFloat) {
120            float f = ((SingleFloat)arg).value;
121            if (Math.abs(f) <= 1)
122                return new SingleFloat((float)Math.asin(f));
123        }
124        if (arg instanceof DoubleFloat) {
125            double d = ((DoubleFloat)arg).value;
126            if (Math.abs(d) <= 1)
127                return new DoubleFloat(Math.asin(d));
128        }
129        LispObject result = arg.multiplyBy(arg);
130        result = Fixnum.ONE.subtract(result);
131        result = sqrt(result);
132        LispObject n = Complex.getInstance(Fixnum.ZERO, Fixnum.ONE);
133        n = n.multiplyBy(arg);
134        result = n.add(result);
135        result = log(result);
136        result = result.multiplyBy(Complex.getInstance(Fixnum.ZERO,
137                                                       Fixnum.MINUS_ONE));
138        if (result instanceof Complex) {
139            if (arg instanceof Complex)
140                return result;
141            LispObject im = ((Complex)result).getImaginaryPart();
142            if (im.zerop())
143                return ((Complex)result).getRealPart();
144        }
145        return result;
146    }
147
148    // ### acos
149    private static final Primitive ACOS = new Primitive("acos", "number")
150    {
151        @Override
152        public LispObject execute(LispObject arg)
153        {
154            return acos(arg);
155        }
156    };
157
158    static LispObject acos(LispObject arg)
159    {
160        if (arg instanceof DoubleFloat) {
161            double d = ((DoubleFloat)arg).value;
162            if (Math.abs(d) <= 1)
163                return new DoubleFloat(Math.acos(d));
164        }
165        if (arg instanceof SingleFloat) {
166            float f = ((SingleFloat)arg).value;
167            if (Math.abs(f) <= 1)
168                return new SingleFloat((float)Math.acos(f));
169        }
170        LispObject result = new DoubleFloat(Math.PI/2);
171        if (!(arg instanceof DoubleFloat)) {
172            if (arg instanceof Complex &&
173                    ((Complex)arg).getRealPart() instanceof DoubleFloat) {
174                    // do nothing; we want to keep the double float value
175            }
176            else
177                result = new SingleFloat((float)((DoubleFloat)result).value);
178        }
179        result = result.subtract(asin(arg));
180        if (result instanceof Complex) {
181            if (arg instanceof Complex)
182                return result;
183            LispObject im = ((Complex)result).getImaginaryPart();
184            if (im.zerop())
185                return ((Complex)result).getRealPart();
186        }
187        return result;
188    }
189
190    // ### atan
191    private static final Primitive ATAN =
192        new Primitive("atan", "number1 &optional number2")
193    {
194        @Override
195        public LispObject execute(LispObject arg)
196        {
197            if (arg.numberp())
198                return atan(arg);
199            return type_error(arg, Symbol.NUMBER);
200        }
201
202        // "If both number1 and number2 are supplied for atan, the result is
203        // the arc tangent of number1/number2."
204
205        // y = +0     x = +0       +0
206        // y = -0     x = +0       -0
207        // y = +0     x = -0       +<PI>
208        // y = -0     x = -0       -<PI>
209        @Override
210        public LispObject execute(LispObject y, LispObject x)
211
212        {
213            if (!y.realp())
214                return type_error(y, Symbol.REAL);
215            if (!x.realp())
216                return type_error(x, Symbol.REAL);
217            double d1, d2;
218            d1 = DoubleFloat.coerceToFloat(y).value;
219            d2 = DoubleFloat.coerceToFloat(x).value;
220            double result = Math.atan2(d1, d2);
221            if (y instanceof DoubleFloat || x instanceof DoubleFloat)
222                return new DoubleFloat(result);
223            else
224                return new SingleFloat((float)result);
225        }
226    };
227
228    static LispObject atan(LispObject arg)
229    {
230        if (arg instanceof Complex) {
231            LispObject im = ((Complex)arg).imagpart;
232            if (im.zerop())
233                return Complex.getInstance(atan(((Complex)arg).realpart),
234                                           im);
235            LispObject result = arg.multiplyBy(arg);
236            result = result.add(Fixnum.ONE);
237            result = Fixnum.ONE.divideBy(result);
238            result = sqrt(result);
239            LispObject n = Complex.getInstance(Fixnum.ZERO, Fixnum.ONE);
240            n = n.multiplyBy(arg);
241            n = n.add(Fixnum.ONE);
242            result = n.multiplyBy(result);
243            result = log(result);
244            result = result.multiplyBy(Complex.getInstance(Fixnum.ZERO, Fixnum.MINUS_ONE));
245            return result;
246        }
247        if (arg instanceof DoubleFloat)
248            return new DoubleFloat(Math.atan(((DoubleFloat)arg).value));
249        return new SingleFloat((float)Math.atan(SingleFloat.coerceToFloat(arg).value));
250    }
251
252    // ### sinh
253    private static final Primitive SINH = new Primitive("sinh", "number")
254    {
255        @Override
256        public LispObject execute(LispObject arg)
257        {
258            return sinh(arg);
259        }
260    };
261
262    static LispObject sinh(LispObject arg)
263    {
264        if (arg instanceof Complex) {
265            LispObject im = ((Complex)arg).getImaginaryPart();
266            if (im.zerop())
267                return Complex.getInstance(sinh(((Complex)arg).getRealPart()),
268                                           im);
269        }
270        if (arg instanceof SingleFloat) {
271            double d = Math.sinh(((SingleFloat)arg).value);
272            return new SingleFloat((float)d);
273        } else if (arg instanceof DoubleFloat) {
274            double d = Math.sinh(((DoubleFloat)arg).value);
275            return new DoubleFloat(d);
276        }
277        LispObject result = exp(arg);
278        result = result.subtract(exp(arg.multiplyBy(Fixnum.MINUS_ONE)));
279        result = result.divideBy(Fixnum.TWO);
280        if (result instanceof Complex) {
281            if (arg instanceof Complex)
282                return result;
283            LispObject im = ((Complex)result).getImaginaryPart();
284            if (im.zerop())
285                return ((Complex)result).getRealPart();
286        }
287        return result;
288    }
289
290    // ### cosh
291    private static final Primitive COSH = new Primitive("cosh", "number")
292    {
293        @Override
294        public LispObject execute(LispObject arg)
295        {
296            return cosh(arg);
297        }
298    };
299
300    static LispObject cosh(LispObject arg)
301    {
302        if (arg instanceof Complex) {
303            LispObject im = ((Complex)arg).getImaginaryPart();
304            if (im.zerop())
305                return Complex.getInstance(cosh(((Complex)arg).getRealPart()),
306                                           im);
307        }
308        if (arg instanceof SingleFloat) {
309            double d = Math.cosh(((SingleFloat)arg).value);
310            return new SingleFloat((float)d);
311        } else if (arg instanceof DoubleFloat) {
312            double d = Math.cosh(((DoubleFloat)arg).value);
313            return new DoubleFloat(d);
314        }
315        LispObject result = exp(arg);
316        result = result.add(exp(arg.multiplyBy(Fixnum.MINUS_ONE)));
317        result = result.divideBy(Fixnum.TWO);
318        if (result instanceof Complex) {
319            if (arg instanceof Complex)
320                return result;
321            LispObject im = ((Complex)result).getImaginaryPart();
322            if (im.zerop())
323                return ((Complex)result).getRealPart();
324        }
325        return result;
326    }
327
328    // ### tanh
329    private static final Primitive TANH = new Primitive("tanh", "number")
330    {
331        @Override
332        public LispObject execute(LispObject arg)
333        {
334            if (arg instanceof SingleFloat) {
335                double d = Math.tanh(((SingleFloat)arg).value);
336                return new SingleFloat((float)d);
337            } else if (arg instanceof DoubleFloat) {
338                double d = Math.tanh(((DoubleFloat)arg).value);
339                return new DoubleFloat(d);
340            }
341            return sinh(arg).divideBy(cosh(arg));
342        }
343    };
344
345    // ### asinh
346    private static final Primitive ASINH = new Primitive("asinh", "number")
347    {
348        @Override
349        public LispObject execute(LispObject arg)
350        {
351            return asinh(arg);
352        }
353    };
354
355    static LispObject asinh(LispObject arg)
356    {
357        if (arg instanceof Complex) {
358            LispObject im = ((Complex)arg).getImaginaryPart();
359            if (im.zerop())
360                return Complex.getInstance(asinh(((Complex)arg).getRealPart()),
361                                           im);
362        }
363        LispObject result = arg.multiplyBy(arg);
364        result = Fixnum.ONE.add(result);
365        result = sqrt(result);
366        result = result.add(arg);
367        result = log(result);
368        if (result instanceof Complex) {
369            if (arg instanceof Complex)
370                return result;
371            LispObject im = ((Complex)result).getImaginaryPart();
372            if (im.zerop())
373                return ((Complex)result).getRealPart();
374        }
375        return result;
376    }
377
378    // ### acosh
379    private static final Primitive ACOSH = new Primitive("acosh", "number")
380    {
381        @Override
382        public LispObject execute(LispObject arg)
383        {
384            return acosh(arg);
385        }
386    };
387
388    static LispObject acosh(LispObject arg)
389    {
390        if (arg instanceof Complex) {
391            LispObject im = ((Complex)arg).getImaginaryPart();
392            if (im.zerop())
393                return Complex.getInstance(acosh(((Complex)arg).getRealPart()),
394                                           im);
395        }
396        LispObject n1 = arg.add(Fixnum.ONE);
397        n1 = n1.divideBy(Fixnum.TWO);
398        n1 = sqrt(n1);
399        LispObject n2 = arg.subtract(Fixnum.ONE);
400        n2 = n2.divideBy(Fixnum.TWO);
401        n2 = sqrt(n2);
402        LispObject result = n1.add(n2);
403        result = log(result);
404        result = result.multiplyBy(Fixnum.TWO);
405        if (result instanceof Complex) {
406            if (arg instanceof Complex)
407                return result;
408            LispObject im = ((Complex)result).getImaginaryPart();
409            if (im.zerop())
410                return ((Complex)result).getRealPart();
411        }
412        return result;
413    }
414
415    // ### atanh
416    private static final Primitive ATANH = new Primitive("atanh", "number")
417    {
418        @Override
419        public LispObject execute(LispObject arg)
420        {
421            return atanh(arg);
422        }
423    };
424
425    static LispObject atanh(LispObject arg)
426    {
427        if (arg instanceof Complex) {
428            LispObject im = ((Complex)arg).getImaginaryPart();
429            if (im.zerop())
430                return Complex.getInstance(atanh(((Complex)arg).getRealPart()),
431                                           im);
432        }
433        LispObject n1 = log(Fixnum.ONE.add(arg));
434        LispObject n2 = log(Fixnum.ONE.subtract(arg));
435        LispObject result = n1.subtract(n2);
436        result = result.divideBy(Fixnum.TWO);
437        if (result instanceof Complex) {
438            if (arg instanceof Complex)
439                return result;
440            LispObject im = ((Complex)result).getImaginaryPart();
441            if (im.zerop())
442                return ((Complex)result).getRealPart();
443        }
444        return result;
445    }
446
447    // ### cis
448    private static final Primitive CIS = new Primitive("cis", "radians")
449    {
450        @Override
451        public LispObject execute(LispObject arg)
452        {
453            return cis(arg);
454        }
455    };
456
457    static LispObject cis(LispObject arg)
458    {
459        if (arg.realp())
460            return Complex.getInstance(cos(arg), sin(arg));
461        return type_error(arg, Symbol.REAL);
462    }
463
464    // ### exp
465    private static final Primitive EXP = new Primitive("exp", "number")
466    {
467        @Override
468        public LispObject execute(LispObject arg)
469        {
470            return exp(arg);
471        }
472    };
473
474    static LispObject exp(LispObject arg)
475    {
476        if (arg.realp()) {
477            if (arg instanceof DoubleFloat) {
478                double d = Math.pow(Math.E, ((DoubleFloat)arg).value);
479                return OverUnderFlowCheck(new DoubleFloat(d));
480            } else {
481                float f = (float) Math.pow(Math.E, SingleFloat.coerceToFloat(arg).value);
482                return OverUnderFlowCheck(new SingleFloat(f));
483            }
484        }
485        if (arg instanceof Complex) {
486            Complex c = (Complex) arg;
487            return exp(c.getRealPart()).multiplyBy(cis(c.getImaginaryPart()));
488        }
489        return type_error(arg, Symbol.NUMBER);
490    }
491
492    // ### sqrt
493    private static final Primitive SQRT = new Primitive("sqrt", "number")
494    {
495        @Override
496        public LispObject execute(LispObject arg)
497        {
498            return sqrt(arg);
499        }
500    };
501
502    static final LispObject sqrt(LispObject obj)
503    {
504        if (obj instanceof DoubleFloat) {
505            if (obj.minusp())
506                return Complex.getInstance(new DoubleFloat(0), sqrt(obj.negate()));
507            return new DoubleFloat(Math.sqrt(DoubleFloat.coerceToFloat(obj).value));
508        }
509        if (obj.realp()) {
510            if (obj.minusp())
511                return Complex.getInstance(new SingleFloat(0), sqrt(obj.negate()));
512            return new SingleFloat((float)Math.sqrt(SingleFloat.coerceToFloat(obj).value));
513        }
514        if (obj instanceof Complex) {
515            LispObject imagpart = ((Complex)obj).imagpart;
516            if (imagpart.zerop()) {
517                LispObject realpart = ((Complex)obj).realpart;
518                if (realpart.minusp())
519                    return Complex.getInstance(imagpart, sqrt(realpart.negate()));
520                else
521                    return Complex.getInstance(sqrt(realpart), imagpart);
522            }
523            return exp(log(obj).divideBy(Fixnum.TWO));
524        }
525        return type_error(obj, Symbol.NUMBER);
526    }
527
528    // ### log
529    private static final Primitive LOG =
530        new Primitive("log", "number &optional base")
531    {
532        @Override
533        public LispObject execute(LispObject arg)
534        {
535            return log(arg);
536        }
537        @Override
538        public LispObject execute(LispObject number, LispObject base)
539
540        {
541            if (number.realp() && !number.minusp()
542                && base.isEqualTo(Fixnum.getInstance(10))) {
543                double d =
544                    Math.log10(DoubleFloat.coerceToFloat(number).value);
545                if (number instanceof DoubleFloat
546                    || base instanceof DoubleFloat)
547                    return new DoubleFloat(d);
548                else
549                    return new SingleFloat((float)d);
550            }
551            return log(number).divideBy(log(base));
552        }
553    };
554
555    static final LispObject log(LispObject obj)
556    {
557        if (obj.realp() && !obj.minusp()) {
558            // Result is real.
559            if (obj instanceof Fixnum)
560                return new SingleFloat((float)Math.log(((Fixnum)obj).value));
561            if (obj instanceof Bignum)
562                return new SingleFloat((float)Math.log(((Bignum)obj).doubleValue()));
563            if (obj instanceof Ratio)
564                return new SingleFloat((float)Math.log(((Ratio)obj).doubleValue()));
565            if (obj instanceof SingleFloat)
566                return new SingleFloat((float)Math.log(((SingleFloat)obj).value));
567            if (obj instanceof DoubleFloat)
568                return new DoubleFloat(Math.log(((DoubleFloat)obj).value));
569        } else {
570            // Result is complex.
571            if (obj.realp() && obj.minusp()) {
572                if (obj instanceof DoubleFloat) {
573                    DoubleFloat re = DoubleFloat.coerceToFloat(obj);
574                    DoubleFloat abs = new DoubleFloat(Math.abs(re.value));
575                    DoubleFloat phase = new DoubleFloat(Math.PI);
576                    return Complex.getInstance(new DoubleFloat(Math.log(abs.getValue())), phase);
577                } else {
578                    SingleFloat re = SingleFloat.coerceToFloat(obj);
579                    SingleFloat abs = new SingleFloat(Math.abs(re.value));
580                    SingleFloat phase = new SingleFloat((float)Math.PI);
581                    return Complex.getInstance(new SingleFloat((float)Math.log(abs.value)), phase);
582                }
583            } else if (obj instanceof Complex) {
584                if (((Complex)obj).getRealPart() instanceof DoubleFloat) {
585                    DoubleFloat re = DoubleFloat.coerceToFloat(((Complex)obj).getRealPart());
586                    DoubleFloat im = DoubleFloat.coerceToFloat(((Complex)obj).getImaginaryPart());
587                    DoubleFloat phase =
588                        new DoubleFloat(Math.atan2(im.getValue(), re.getValue()));  // atan(y/x)
589                    DoubleFloat abs = DoubleFloat.coerceToFloat(obj.ABS());
590                    return Complex.getInstance(new DoubleFloat(Math.log(abs.getValue())), phase);
591                } else {
592                    SingleFloat re = SingleFloat.coerceToFloat(((Complex)obj).getRealPart());
593                    SingleFloat im = SingleFloat.coerceToFloat(((Complex)obj).getImaginaryPart());
594                    SingleFloat phase =
595                        new SingleFloat((float)Math.atan2(im.value, re.value));  // atan(y/x)
596                    SingleFloat abs = SingleFloat.coerceToFloat(obj.ABS());
597                    return Complex.getInstance(new SingleFloat((float)Math.log(abs.value)), phase);
598                }
599            }
600        }
601        type_error(obj, Symbol.NUMBER);
602        return NIL;
603    }
604
605    // ### expt base-number power-number => result
606    public static final Primitive EXPT =
607        new Primitive("expt", "base-number power-number")
608    {
609        @Override
610        public LispObject execute(LispObject base, LispObject power)
611
612        {
613            if (power.zerop()) {
614                if (power instanceof Fixnum) {
615                    if (base instanceof SingleFloat)
616                        return SingleFloat.ONE;
617                    if (base instanceof DoubleFloat)
618                        return DoubleFloat.ONE;
619                    if (base instanceof Complex) {
620                        if (((Complex)base).realpart instanceof SingleFloat)
621                            return Complex.getInstance(SingleFloat.ONE,
622                                                       SingleFloat.ZERO);
623                        if (((Complex)base).realpart instanceof DoubleFloat)
624                            return Complex.getInstance(DoubleFloat.ONE,
625                                                       DoubleFloat.ZERO);
626                    }
627                    return Fixnum.ONE;
628                }
629                if (power instanceof DoubleFloat)
630                    return DoubleFloat.ONE;
631                if (base instanceof DoubleFloat)
632                    return DoubleFloat.ONE;
633                return SingleFloat.ONE;
634            }
635            if (base.zerop())
636                return base;
637            if (base.isEqualTo(1))
638                return base;
639           
640            if ((power instanceof Fixnum
641                 || power instanceof Bignum)
642                 && (base.rationalp()
643                     || (base instanceof Complex
644                         && ((Complex)base).realpart.rationalp()))) {
645                // exact math version
646                return intexp(base, power);
647            }
648            // for anything not a rational or complex rational, use
649            // float approximation.
650            if (base instanceof Complex || power instanceof Complex)
651                return exp(power.multiplyBy(log(base)));
652            final double x; // base
653            final double y; // power
654            if (base instanceof Fixnum)
655                x = ((Fixnum)base).value;
656            else if (base instanceof Bignum)
657                x = ((Bignum)base).doubleValue();
658            else if (base instanceof Ratio)
659                x = ((Ratio)base).doubleValue();
660            else if (base instanceof SingleFloat)
661                x = ((SingleFloat)base).value;
662            else if (base instanceof DoubleFloat)
663                x = ((DoubleFloat)base).value;
664            else
665                return error(new LispError("EXPT: unsupported case: base is of type " +
666                                            base.typeOf().writeToString()));
667
668            if (power instanceof Fixnum)
669                y = ((Fixnum)power).value;
670            else if (power instanceof Bignum)
671                y = ((Bignum)power).doubleValue();
672            else if (power instanceof Ratio)
673                y = ((Ratio)power).doubleValue();
674            else if (power instanceof SingleFloat)
675                y = ((SingleFloat)power).value;
676            else if (power instanceof DoubleFloat)
677                y = ((DoubleFloat)power).value;
678            else
679                return error(new LispError("EXPT: unsupported case: power is of type " +
680                                            power.typeOf().writeToString()));
681            double r = Math.pow(x, y);
682            if (Double.isNaN(r)) {
683                if (x < 0) {
684                    r = Math.pow(-x, y);
685                    double realPart = r * Math.cos(y * Math.PI);
686                    double imagPart = r * Math.sin(y * Math.PI);
687                    if (base instanceof DoubleFloat || power instanceof DoubleFloat)
688                        return Complex
689                            .getInstance(OverUnderFlowCheck(new DoubleFloat(realPart)),
690                                         OverUnderFlowCheck(new DoubleFloat(imagPart)));
691                    else
692                        return Complex
693                            .getInstance(OverUnderFlowCheck(new SingleFloat((float)realPart)),
694                                         OverUnderFlowCheck(new SingleFloat((float)imagPart)));
695                }
696            }
697            if (base instanceof DoubleFloat || power instanceof DoubleFloat)
698                return OverUnderFlowCheck(new DoubleFloat(r));
699            else
700                return OverUnderFlowCheck(new SingleFloat((float)r));
701        }
702    };
703
704    /** Checks number for over- or underflow values.
705     *
706     * @param number
707     * @return number or signals an appropriate error
708     */
709    final static LispObject OverUnderFlowCheck(LispObject number)
710
711    {
712        if (number instanceof Complex) {
713            OverUnderFlowCheck(((Complex)number).realpart);
714            OverUnderFlowCheck(((Complex)number).imagpart);
715            return number;
716        }
717
718        if (TRAP_OVERFLOW) {
719            if (number instanceof SingleFloat)
720                if (Float.isInfinite(((SingleFloat)number).value))
721                    return error(new FloatingPointOverflow(NIL));
722            if (number instanceof DoubleFloat)
723                if (Double.isInfinite(((DoubleFloat)number).value))
724                    return error(new FloatingPointOverflow(NIL));
725        }
726        if (TRAP_UNDERFLOW) {
727            if (number.zerop())
728                return error(new FloatingPointUnderflow(NIL));
729        }
730        return number;
731    }
732
733    /** Checks number for over- or underflow values.
734     *
735     * @param number
736     * @return number or signals an appropriate error
737     */
738    final static float OverUnderFlowCheck(float number)
739
740    {
741        if (TRAP_OVERFLOW) {
742            if (Float.isInfinite(number))
743                error(new FloatingPointOverflow(NIL));
744        }
745        if (TRAP_UNDERFLOW) {
746            if (number == 0)
747                error(new FloatingPointUnderflow(NIL));
748        }
749        return number;
750    }
751
752    /** Checks number for over- or underflow values.
753     *
754     * @param number
755     * @return number or signals an appropriate error
756     */
757    public final static double OverUnderFlowCheck(double number)
758
759    {
760        if (TRAP_OVERFLOW) {
761            if (Double.isInfinite(number))
762                error(new FloatingPointOverflow(NIL));
763        }
764        if (TRAP_UNDERFLOW) {
765            if (number == 0)
766                error(new FloatingPointUnderflow(NIL));
767        }
768        return number;
769    }
770    // Adapted from SBCL.
771    /** Return the exponent of base taken to the integer exponent power
772     *
773     * @param base A value of any type
774     * @param power An integer (fixnum or bignum) value
775     */
776    static final LispObject intexp(LispObject base, LispObject power)
777
778    {
779        if (power.isEqualTo(0))
780            return Fixnum.ONE;
781        if (base.isEqualTo(1))
782            return base;
783        if (base.isEqualTo(0))
784            return base;
785
786        if (power.minusp()) {
787            power = Fixnum.ZERO.subtract(power);
788            return Fixnum.ONE.divideBy(intexp(base, power));
789        }
790        if (base.eql(Fixnum.TWO))
791            return Fixnum.ONE.ash(power);
792
793        LispObject nextn = power.ash(Fixnum.MINUS_ONE);
794        LispObject total;
795        if (power.oddp())
796            total = base;
797        else
798            total = Fixnum.ONE;
799        while (true) {
800            if (nextn.zerop())
801                return total;
802            base = base.multiplyBy(base);
803
804            if (nextn.oddp())
805                total = base.multiplyBy(total);
806            nextn = nextn.ash(Fixnum.MINUS_ONE);
807        }
808    }
809}
Note: See TracBrowser for help on using the repository browser.