/[cmucl]/src/code/irrat.lisp
ViewVC logotype

Diff of /src/code/irrat.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.60.2.6 by rtoy, Thu Feb 25 01:11:57 2010 UTC revision 1.64 by rtoy, Mon Feb 28 17:14:45 2011 UTC
# Line 179  Line 179 
179    
180  ;; As above for x86.  It also seems to be needed to handle  ;; As above for x86.  It also seems to be needed to handle
181  ;; constant-folding in the compiler.  ;; constant-folding in the compiler.
182  #+sparc  #+(or sparc (and x86 sse2))
183  (progn  (progn
184    (defun %sqrt (x)    (defun %sqrt (x)
185      (declare (double-float x)      (declare (double-float x)
# Line 293  Line 293 
293  ;;;; Power functions.  ;;;; Power functions.
294    
295  (defun exp (number)  (defun exp (number)
296    _N"Return e raised to the power NUMBER."    "Return e raised to the power NUMBER."
297    (number-dispatch ((number number))    (number-dispatch ((number number))
298      (handle-reals %exp number)      (handle-reals %exp number)
299      ((complex)      ((complex)
# Line 308  Line 308 
308    ((base :initarg :base :reader intexp-base)    ((base :initarg :base :reader intexp-base)
309     (power :initarg :power :reader intexp-power))     (power :initarg :power :reader intexp-power))
310    (:report (lambda (condition stream)    (:report (lambda (condition stream)
311               (format stream _"The absolute value of ~S exceeds limit ~S."               (format stream (intl:gettext "The absolute value of ~S exceeds limit ~S.")
312                       (intexp-power condition)                       (intexp-power condition)
313                       *intexp-maximum-exponent*))))                       *intexp-maximum-exponent*))))
314    
# Line 333  Line 333 
333                 :power power)                 :power power)
334        (continue ()        (continue ()
335          :report (lambda (stream)          :report (lambda (stream)
336                    (write-string _"Continue with calculation" stream)))                    (write-string (intl:gettext "Continue with calculation") stream)))
337        (new-limit ()        (new-limit ()
338          :report (lambda (stream)          :report (lambda (stream)
339                    (write-string _"Continue with calculation, update limit" stream))                    (write-string (intl:gettext "Continue with calculation, update limit") stream))
340          (setq *intexp-maximum-exponent* (abs power)))))          (setq *intexp-maximum-exponent* (abs power)))))
341    (cond ((minusp power)    (cond ((minusp power)
342           (/ (intexp base (- power))))           (/ (intexp base (- power))))
# Line 360  Line 360 
360  ;;; the complex-real and real-complex cases from the general complex case.  ;;; the complex-real and real-complex cases from the general complex case.
361  ;;;  ;;;
362  (defun expt (base power)  (defun expt (base power)
363    _N"Returns BASE raised to the POWER."    "Returns BASE raised to the POWER."
364    (if (zerop power)    (if (zerop power)
365        ;; CLHS says that if the power is 0, the result is 1, subject to        ;; CLHS says that if the power is 0, the result is 1, subject to
366        ;; numeric contagion.  But what happens if base is infinity or        ;; numeric contagion.  But what happens if base is infinity or
# Line 676  Line 676 
676           (+ n frac))))))           (+ n frac))))))
677    
678  (defun log (number &optional (base nil base-p))  (defun log (number &optional (base nil base-p))
679    _N"Return the logarithm of NUMBER in the base BASE, which defaults to e."    "Return the logarithm of NUMBER in the base BASE, which defaults to e."
680    (if base-p    (if base-p
681        (cond ((zerop base)        (cond ((zerop base)
682               ;; ANSI spec               ;; ANSI spec
# Line 804  Line 804 
804           (complex-log number)))))           (complex-log number)))))
805    
806  (defun sqrt (number)  (defun sqrt (number)
807    _N"Return the square root of NUMBER."    "Return the square root of NUMBER."
808    (number-dispatch ((number number))    (number-dispatch ((number number))
809      (((foreach fixnum bignum ratio))      (((foreach fixnum bignum ratio))
810       (if (minusp number)       (if (minusp number)
# Line 829  Line 829 
829  ;;;; Trigonometic and Related Functions  ;;;; Trigonometic and Related Functions
830    
831  (defun abs (number)  (defun abs (number)
832    _N"Returns the absolute value of the number."    "Returns the absolute value of the number."
833    (number-dispatch ((number number))    (number-dispatch ((number number))
834      (((foreach single-float double-float fixnum rational      (((foreach single-float double-float fixnum rational
835                 #+double-double double-double-float))                 #+double-double double-double-float))
# Line 853  Line 853 
853              (scale-float (sqrt abs^2) scale))))))))              (scale-float (sqrt abs^2) scale))))))))
854    
855  (defun phase (number)  (defun phase (number)
856    _N"Returns the angle part of the polar representation of a complex number.    "Returns the angle part of the polar representation of a complex number.
857    For complex numbers, this is (atan (imagpart number) (realpart number)).    For complex numbers, this is (atan (imagpart number) (realpart number)).
858    For non-complex positive numbers, this is 0.  For non-complex negative    For non-complex positive numbers, this is 0.  For non-complex negative
859    numbers this is PI."    numbers this is PI."
# Line 880  Line 880 
880    
881    
882  (defun sin (number)  (defun sin (number)
883    _N"Return the sine of NUMBER."    "Return the sine of NUMBER."
884    (number-dispatch ((number number))    (number-dispatch ((number number))
885      (handle-reals %sin number)      (handle-reals %sin number)
886      ((complex)      ((complex)
# Line 890  Line 890 
890                  (* (cos x) (sinh y)))))))                  (* (cos x) (sinh y)))))))
891    
892  (defun cos (number)  (defun cos (number)
893    _N"Return the cosine of NUMBER."    "Return the cosine of NUMBER."
894    (number-dispatch ((number number))    (number-dispatch ((number number))
895      (handle-reals %cos number)      (handle-reals %cos number)
896      ((complex)      ((complex)
# Line 900  Line 900 
900                  (- (* (sin x) (sinh y))))))))                  (- (* (sin x) (sinh y))))))))
901    
902  (defun tan (number)  (defun tan (number)
903    _N"Return the tangent of NUMBER."    "Return the tangent of NUMBER."
904    (number-dispatch ((number number))    (number-dispatch ((number number))
905      (handle-reals %tan number)      (handle-reals %tan number)
906      ((complex)      ((complex)
907       (complex-tan number))))       (complex-tan number))))
908    
909  (defun cis (theta)  (defun cis (theta)
910    _N"Return cos(Theta) + i sin(Theta), AKA exp(i Theta)."    "Return cos(Theta) + i sin(Theta), AKA exp(i Theta)."
911    (if (complexp theta)    (if (complexp theta)
912        (error _"Argument to CIS is complex: ~S" theta)        (error (intl:gettext "Argument to CIS is complex: ~S") theta)
913        (complex (cos theta) (sin theta))))        (complex (cos theta) (sin theta))))
914    
915  (defun asin (number)  (defun asin (number)
916    _N"Return the arc sine of NUMBER."    "Return the arc sine of NUMBER."
917    (number-dispatch ((number number))    (number-dispatch ((number number))
918      ((rational)      ((rational)
919       (if (or (> number 1) (< number -1))       (if (or (> number 1) (< number -1))
# Line 937  Line 937 
937       (complex-asin number))))       (complex-asin number))))
938    
939  (defun acos (number)  (defun acos (number)
940    _N"Return the arc cosine of NUMBER."    "Return the arc cosine of NUMBER."
941    (number-dispatch ((number number))    (number-dispatch ((number number))
942      ((rational)      ((rational)
943       (if (or (> number 1) (< number -1))       (if (or (> number 1) (< number -1))
# Line 962  Line 962 
962    
963    
964  (defun atan (y &optional (x nil xp))  (defun atan (y &optional (x nil xp))
965    _N"Return the arc tangent of Y if X is omitted or Y/X if X is supplied."    "Return the arc tangent of Y if X is omitted or Y/X if X is supplied."
966    (if xp    (if xp
967        (flet ((atan2 (y x)        (flet ((atan2 (y x)
968                 (declare (type double-float y x)                 (declare (type double-float y x)
# Line 1000  Line 1000 
1000           (complex-atan y)))))           (complex-atan y)))))
1001    
1002  (defun sinh (number)  (defun sinh (number)
1003    _N"Return the hyperbolic sine of NUMBER."    "Return the hyperbolic sine of NUMBER."
1004    (number-dispatch ((number number))    (number-dispatch ((number number))
1005      (handle-reals %sinh number)      (handle-reals %sinh number)
1006      ((complex)      ((complex)
# Line 1010  Line 1010 
1010                  (* (cosh x) (sin y)))))))                  (* (cosh x) (sin y)))))))
1011    
1012  (defun cosh (number)  (defun cosh (number)
1013    _N"Return the hyperbolic cosine of NUMBER."    "Return the hyperbolic cosine of NUMBER."
1014    (number-dispatch ((number number))    (number-dispatch ((number number))
1015      (handle-reals %cosh number)      (handle-reals %cosh number)
1016      ((complex)      ((complex)
# Line 1020  Line 1020 
1020                  (* (sinh x) (sin y)))))))                  (* (sinh x) (sin y)))))))
1021    
1022  (defun tanh (number)  (defun tanh (number)
1023    _N"Return the hyperbolic tangent of NUMBER."    "Return the hyperbolic tangent of NUMBER."
1024    (number-dispatch ((number number))    (number-dispatch ((number number))
1025      (handle-reals %tanh number)      (handle-reals %tanh number)
1026      ((complex)      ((complex)
1027       (complex-tanh number))))       (complex-tanh number))))
1028    
1029  (defun asinh (number)  (defun asinh (number)
1030    _N"Return the hyperbolic arc sine of NUMBER."    "Return the hyperbolic arc sine of NUMBER."
1031    (number-dispatch ((number number))    (number-dispatch ((number number))
1032      (handle-reals %asinh number)      (handle-reals %asinh number)
1033      ((complex)      ((complex)
1034       (complex-asinh number))))       (complex-asinh number))))
1035    
1036  (defun acosh (number)  (defun acosh (number)
1037    _N"Return the hyperbolic arc cosine of NUMBER."    "Return the hyperbolic arc cosine of NUMBER."
1038    (number-dispatch ((number number))    (number-dispatch ((number number))
1039      ((rational)      ((rational)
1040       ;; acosh is complex if number < 1       ;; acosh is complex if number < 1
# Line 1055  Line 1055 
1055       (complex-acosh number))))       (complex-acosh number))))
1056    
1057  (defun atanh (number)  (defun atanh (number)
1058    _N"Return the hyperbolic arc tangent of NUMBER."    "Return the hyperbolic arc tangent of NUMBER."
1059    (number-dispatch ((number number))    (number-dispatch ((number number))
1060      ((rational)      ((rational)
1061       ;; atanh is complex if |number| > 1       ;; atanh is complex if |number| > 1
# Line 1152  Line 1152 
1152    
1153  (declaim (inline scalb))  (declaim (inline scalb))
1154  (defun scalb (x n)  (defun scalb (x n)
1155    _N"Compute 2^N * X without compute 2^N first (use properties of the    "Compute 2^N * X without compute 2^N first (use properties of the
1156  underlying floating-point format"  underlying floating-point format"
1157    (declare (type float x)    (declare (type float x)
1158             (type double-float-exponent n))             (type double-float-exponent n))
# Line 1160  underlying floating-point format" Line 1160  underlying floating-point format"
1160    
1161  (declaim (inline logb-finite))  (declaim (inline logb-finite))
1162  (defun logb-finite (x)  (defun logb-finite (x)
1163    _N"Same as logb but X is not infinity and non-zero and not a NaN, so    "Same as logb but X is not infinity and non-zero and not a NaN, so
1164  that we can always return an integer"  that we can always return an integer"
1165    (declare (type float x))    (declare (type float x))
1166    (multiple-value-bind (signif expon sign)    (multiple-value-bind (signif expon sign)
# Line 1171  that we can always return an integer" Line 1171  that we can always return an integer"
1171      (1- expon)))      (1- expon)))
1172    
1173  (defun logb (x)  (defun logb (x)
1174    _N"Compute an integer N such that 1 <= |2^(-N) * x| < 2.    "Compute an integer N such that 1 <= |2^(-N) * x| < 2.
1175  For the special cases, the following values are used:  For the special cases, the following values are used:
1176    
1177      x             logb      x             logb
# Line 1199  For the special cases, the following val Line 1199  For the special cases, the following val
1199    
1200  (declaim (inline coerce-to-complex-type))  (declaim (inline coerce-to-complex-type))
1201  (defun coerce-to-complex-type (x y z)  (defun coerce-to-complex-type (x y z)
1202    _N"Create complex number with real part X and imaginary part Y such that    "Create complex number with real part X and imaginary part Y such that
1203  it has the same type as Z.  If Z has type (complex rational), the X  it has the same type as Z.  If Z has type (complex rational), the X
1204  and Y are coerced to single-float."  and Y are coerced to single-float."
1205    (declare (double-float x y)    (declare (double-float x y)
# Line 1250  and Y are coerced to single-float." Line 1250  and Y are coerced to single-float."
1250                 (values rho 0)))))))                 (values rho 0)))))))
1251    
1252  (defun complex-sqrt (z)  (defun complex-sqrt (z)
1253    _N"Principle square root of Z    "Principle square root of Z
1254    
1255  Z may be any number, but the result is always a complex."  Z may be any number, but the result is always a complex."
1256    (declare (number z))    (declare (number z))
# Line 1295  Z may be any number, but the result is a Line 1295  Z may be any number, but the result is a
1295          (coerce-to-complex-type eta nu z)))))          (coerce-to-complex-type eta nu z)))))
1296    
1297  (defun complex-log-scaled (z j)  (defun complex-log-scaled (z j)
1298    _N"Compute log(2^j*z).    "Compute log(2^j*z).
1299    
1300  This is for use with J /= 0 only when |z| is huge."  This is for use with J /= 0 only when |z| is huge."
1301    (declare (number z)    (declare (number z)
# Line 1330  This is for use with J /= 0 only when |z Line 1330  This is for use with J /= 0 only when |z
1330                                  z)))))                                  z)))))
1331    
1332  (defun complex-log (z)  (defun complex-log (z)
1333    _N"Log of Z = log |Z| + i * arg Z    "Log of Z = log |Z| + i * arg Z
1334    
1335  Z may be any number, but the result is always a complex."  Z may be any number, but the result is always a complex."
1336    (declare (number z))    (declare (number z))
# Line 1345  Z may be any number, but the result is a Line 1345  Z may be any number, but the result is a
1345  ;; never 0 since we have positive and negative zeroes.  ;; never 0 since we have positive and negative zeroes.
1346    
1347  (defun complex-atanh (z)  (defun complex-atanh (z)
1348    _N"Compute atanh z = (log(1+z) - log(1-z))/2"    "Compute atanh z = (log(1+z) - log(1-z))/2"
1349    (declare (number z))    (declare (number z))
1350    #+double-double    #+double-double
1351    (when (typep z '(or double-double-float (complex double-double-float)))    (when (typep z '(or double-double-float (complex double-double-float)))
# Line 1409  Z may be any number, but the result is a Line 1409  Z may be any number, but the result is a
1409                                    z)))))                                    z)))))
1410    
1411  (defun complex-tanh (z)  (defun complex-tanh (z)
1412    _N"Compute tanh z = sinh z / cosh z"    "Compute tanh z = sinh z / cosh z"
1413    (declare (number z))    (declare (number z))
1414    #+double-double    #+double-double
1415    (when (typep z '(or double-double-float (complex double-double-float)))    (when (typep z '(or double-double-float (complex double-double-float)))
# Line 1494  Z may be any number, but the result is a Line 1494  Z may be any number, but the result is a
1494    (complex (+ (realpart z) 1) (imagpart z)))    (complex (+ (realpart z) 1) (imagpart z)))
1495    
1496  (defun complex-acos (z)  (defun complex-acos (z)
1497    _N"Compute acos z = pi/2 - asin z    "Compute acos z = pi/2 - asin z
1498    
1499  Z may be any number, but the result is always a complex."  Z may be any number, but the result is always a complex."
1500    (declare (number z))    (declare (number z))
# Line 1513  Z may be any number, but the result is a Line 1513  Z may be any number, but the result is a
1513                                         sqrt-1-z))))))))                                         sqrt-1-z))))))))
1514    
1515  (defun complex-acosh (z)  (defun complex-acosh (z)
1516    _N"Compute acosh z = 2 * log(sqrt((z+1)/2) + sqrt((z-1)/2))    "Compute acosh z = 2 * log(sqrt((z+1)/2) + sqrt((z-1)/2))
1517    
1518  Z may be any number, but the result is always a complex."  Z may be any number, but the result is always a complex."
1519    (declare (number z))    (declare (number z))
# Line 1527  Z may be any number, but the result is a Line 1527  Z may be any number, but the result is a
1527    
1528    
1529  (defun complex-asin (z)  (defun complex-asin (z)
1530    _N"Compute asin z = asinh(i*z)/i    "Compute asin z = asinh(i*z)/i
1531    
1532  Z may be any number, but the result is always a complex."  Z may be any number, but the result is always a complex."
1533    (declare (number z))    (declare (number z))
# Line 1546  Z may be any number, but the result is a Line 1546  Z may be any number, but the result is a
1546                                         sqrt-1+z))))))))                                         sqrt-1+z))))))))
1547    
1548  (defun complex-asinh (z)  (defun complex-asinh (z)
1549    _N"Compute asinh z = log(z + sqrt(1 + z*z))    "Compute asinh z = log(z + sqrt(1 + z*z))
1550    
1551  Z may be any number, but the result is always a complex."  Z may be any number, but the result is always a complex."
1552    (declare (number z))    (declare (number z))
# Line 1560  Z may be any number, but the result is a Line 1560  Z may be any number, but the result is a
1560               (- (realpart result)))))               (- (realpart result)))))
1561    
1562  (defun complex-atan (z)  (defun complex-atan (z)
1563    _N"Compute atan z = atanh (i*z) / i    "Compute atan z = atanh (i*z) / i
1564    
1565  Z may be any number, but the result is always a complex."  Z may be any number, but the result is always a complex."
1566    (declare (number z))    (declare (number z))
# Line 1574  Z may be any number, but the result is a Line 1574  Z may be any number, but the result is a
1574               (- (realpart result)))))               (- (realpart result)))))
1575    
1576  (defun complex-tan (z)  (defun complex-tan (z)
1577    _N"Compute tan z = -i * tanh(i * z)    "Compute tan z = -i * tanh(i * z)
1578    
1579  Z may be any number, but the result is always a complex."  Z may be any number, but the result is always a complex."
1580    (declare (number z))    (declare (number z))

Legend:
Removed from v.1.60.2.6  
changed lines
  Added in v.1.64

  ViewVC Help
Powered by ViewVC 1.1.5