X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Firrat.lisp;h=1c684acda2964671cb239173819f44872a000c67;hb=6e60dc9f79037ab84f5bfd8568979c24291c9922;hp=93c957bbcec95f0683b0a29f3cea563336e302af;hpb=79c4a7fec90e697d1a5896c7883ff24d562bad6d;p=sbcl.git diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp index 93c957b..1c684ac 100644 --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -323,8 +323,12 @@ (coerce (* pow (%cos y*pi)) rtype) (coerce (* pow (%sin y*pi)) - rtype))))))))))))) - (declare (inline real-expt)) + rtype)))))))))))) + (complex-expt (base power) + (if (and (zerop base) (plusp (realpart power))) + (* base power) + (exp (* power (log base)))))) + (declare (inline real-expt complex-expt)) (number-dispatch ((base number) (power number)) (((foreach fixnum (or bignum ratio) (complex rational)) integer) (intexp base power)) @@ -338,19 +342,33 @@ (real-expt base power 'double-float)) ((double-float single-float) (real-expt base power 'double-float)) - (((foreach (complex rational) (complex float)) rational) + ;; Handle (expt ), except the case dealt with + ;; in the first clause above, (expt <(complex rational)> ). + (((foreach (complex rational) (complex single-float) + (complex double-float)) + rational) (* (expt (abs base) power) (cis (* power (phase base))))) - (((foreach fixnum (or bignum ratio) single-float double-float) - complex) - (if (and (zerop base) (plusp (realpart power))) - (* base power) - (exp (* power (log base))))) - (((foreach (complex float) (complex rational)) + ;; The next three clauses handle (expt ). + (((foreach fixnum (or bignum ratio) single-float) + (foreach (complex single-float) (complex rational))) + (complex-expt base power)) + (((foreach fixnum (or bignum ratio) single-float) + (complex double-float)) + (complex-expt (coerce base 'double-float) power)) + ((double-float complex) + (complex-expt base power)) + ;; The next three clauses handle (expt ) and + ;; (expt ). + (((foreach (complex single-float) (complex rational)) + (foreach (complex single-float) (complex rational) single-float)) + (complex-expt base power)) + (((foreach (complex single-float) (complex rational)) + (foreach (complex double-float) double-float)) + (complex-expt (coerce base '(complex double-float)) power)) + (((complex double-float) (foreach complex double-float single-float)) - (if (and (zerop base) (plusp (realpart power))) - (* base power) - (exp (* power (log base))))))))) + (complex-expt base power)))))) ;;; FIXME: Maybe rename this so that it's clearer that it only works ;;; on integers?