source: branches/0.22.x/abcl/src/org/armedbear/lisp/MathFunctions.java

Last change on this file 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.