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

Last change on this file was 12254, checked in by ehuelsmann, 16 years ago

Remove 'throws ConditionThrowable?' method annotations:

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