[oct-cvs] Oct commit: oct qd-complex.lisp qd-methods.lisp
rtoy
rtoy at common-lisp.net
Fri Aug 31 03:11:00 UTC 2007
Update of /project/oct/cvsroot/oct
In directory clnet:/tmp/cvs-serv9259
Modified Files:
qd-complex.lisp qd-methods.lisp
Log Message:
Get rid of the extra layer of function calls and define the special
functions as methods directly.
--- /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/30 23:42:24 1.33
+++ /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/31 03:11:00 1.34
@@ -668,69 +668,69 @@
(- (realpart result)))))
;; End of implementation of complex functions from CMUCL.
-(defmethod qasin ((x qd-complex))
+(defmethod asin ((x qd-complex))
(qd-complex-asin x))
-(defmethod qacos ((x qd-complex))
+(defmethod acos ((x qd-complex))
(qd-complex-acos x))
-(defmethod qacosh ((x qd-complex))
+(defmethod acosh ((x qd-complex))
(qd-complex-acosh x))
-(defmethod qatanh ((x qd-complex))
+(defmethod atanh ((x qd-complex))
(qd-complex-atanh x))
-(defmethod qsin ((z qd-complex))
+(defmethod sin ((z qd-complex))
(let ((x (realpart z))
(y (imagpart z)))
(complex (* (sin x) (cosh y))
(* (cos x) (sinh y)))))
-(defmethod qcos ((z qd-complex))
+(defmethod cos ((z qd-complex))
(let ((x (realpart z))
(y (imagpart z)))
(complex (* (cos x) (cosh y))
(- (* (sin x) (sinh y))))))
-(defmethod qtan ((z qd-complex))
+(defmethod tan ((z qd-complex))
(qd-complex-tan z))
-(defmethod qsinh ((z qd-complex))
+(defmethod sinh ((z qd-complex))
(let ((x (realpart z))
(y (imagpart z)))
(complex (* (sinh x) (cos y))
(* (cosh x) (sin y)))))
-(defmethod qcosh ((z qd-complex))
+(defmethod cosh ((z qd-complex))
(let ((x (realpart z))
(y (imagpart z)))
(complex (* (cosh x) (cos y))
(* (sinh x) (sin y)))))
-(defmethod qtanh ((z qd-complex))
+(defmethod tanh ((z qd-complex))
(qd-complex-tanh z))
-(defmethod qsqrt ((z qd-complex))
+(defmethod sqrt ((z qd-complex))
(qd-complex-sqrt z))
-(defmethod qatan ((y qd-complex) &optional x)
+(defmethod atan ((y qd-complex) &optional x)
(if x
(error "First arg of 2-arg ATAN must be real")
(qd-complex-atan y)))
-(defmethod qatan ((y cl:complex) &optional x)
+(defmethod atan ((y cl:complex) &optional x)
(if x
(error "First arg of 2-arg ATAN must be real")
(cl:atan y)))
-(defmethod qexp ((z qd-complex))
+(defmethod exp ((z qd-complex))
(let* ((x (realpart z))
(y (imagpart z))
(ex (exp x)))
(complex (* ex (cos y))
(* ex (sin y)))))
-(defmethod qlog ((a qd-complex) &optional b)
+(defmethod log ((a qd-complex) &optional b)
(if b
(/ (qlog a) (qlog b))
(complex (log (abs a))
@@ -745,7 +745,7 @@
(defmethod qexpt ((x qd-complex) (y qd-complex))
(exp (* y (log x))))
-(defmethod qphase ((z qd-complex))
+(defmethod phase ((z qd-complex))
(atan (imagpart z) (realpart z)))
(defun realp (x)
--- /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/29 14:37:20 1.52
+++ /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/31 03:11:00 1.53
@@ -356,13 +356,10 @@
(cl-name (intern (symbol-name name) :cl))
(qd-name (intern (concatenate 'string (symbol-name name) "-QD"))))
`(progn
- (defmethod ,method-name ((x number))
+ (defmethod ,name ((x number))
(,cl-name x))
- (defmethod ,method-name ((x qd-real))
- (make-instance 'qd-real :value (,qd-name (qd-value x))))
- (declaim (inline ,name))
- (defun ,name (x)
- (,method-name x))))))
+ (defmethod ,name ((x qd-real))
+ (make-instance 'qd-real :value (,qd-name (qd-value x))))))))
(frob abs)
(frob exp)
(frob sin)
@@ -378,19 +375,16 @@
;;(frob atanh)
)
-(defmethod qsqrt ((x number))
+(defmethod sqrt ((x number))
(cl:sqrt x))
-(defmethod qsqrt ((x qd-real))
+(defmethod sqrt ((x qd-real))
(if (minusp x)
(make-instance 'qd-complex
:real +qd-zero+
:imag (sqrt-qd (neg-qd (qd-value x))))
(make-instance 'qd-real :value (sqrt-qd (qd-value x)))))
-(defun sqrt (x)
- (qsqrt x))
-
(defun scalb (x n)
"Compute 2^N * X without compute 2^N first (use properties of the
underlying floating-point format"
@@ -422,12 +416,12 @@
:value (hypot-qd (qd-value (realpart z))
(qd-value (imagpart z)))))
-(defmethod qlog ((a number) &optional b)
+(defmethod log ((a number) &optional b)
(if b
(cl:log a b)
(cl:log a)))
-(defmethod qlog ((a qd-real) &optional b)
+(defmethod log ((a qd-real) &optional b)
(if b
(/ (qlog a) (qlog b))
(if (minusp (float-sign a))
@@ -436,15 +430,10 @@
:imag +qd-pi+)
(make-instance 'qd-real :value (log-qd (qd-value a))))))
-(declaim (inline log))
-(defun log (a &optional b)
- (qlog a b))
-
-
(defmethod log1p ((a qd-real))
(make-instance 'qd-real :value (log1p-qd (qd-value a))))
-(defmethod qatan ((y real) &optional x)
+(defmethod atan ((y real) &optional x)
(cond (x
(cond ((typep x 'qd-real)
(make-instance 'qd-real
@@ -454,17 +443,13 @@
(t
(cl:atan y))))
-(defmethod qatan ((y qd-real) &optional x)
+(defmethod atan ((y qd-real) &optional x)
(make-instance 'qd-real
:value
(if x
(atan2-qd (qd-value y) (qd-value x))
(atan-qd (qd-value y)))))
-(defun atan (y &optional x)
- (qatan y x))
-
-
(defmethod qexpt ((x number) (y number))
(cl:expt x y))
@@ -732,83 +717,57 @@
(if (< (car nlist) result)
(setq result (car nlist)))))
-(defmethod qasin ((x number))
+(defmethod asin ((x number))
(cl:asin x))
-(defmethod qasin ((x qd-real))
+(defmethod asin ((x qd-real))
(if (<= -1 x 1)
(make-instance 'qd-real :value (asin-qd (qd-value x)))
(qd-complex-asin x)))
-(declaim (inline asin))
-(defun asin (x)
- (qasin x))
-
-(defmethod qacos ((x number))
+(defmethod acos ((x number))
(cl:acos x))
-(defmethod qacos ((x qd-real))
+(defmethod acos ((x qd-real))
(cond ((> (abs x) 1)
(qd-complex-acos x))
(t
(make-instance 'qd-real :value (acos-qd (qd-value x))))))
-(declaim (inline acos))
-(defun acos (x)
- (qacos x))
-
-(defmethod qacosh ((x number))
+(defmethod acosh ((x number))
(cl:acosh x))
-(defmethod qacosh ((x qd-real))
+(defmethod acosh ((x qd-real))
(if (< x 1)
(qd-complex-acosh x)
(make-instance 'qd-real :value (acosh-qd (qd-value x)))))
-
-(declaim (inline acosh))
-(defun acosh (x)
- (qacosh x))
-
-(defmethod qatanh ((x number))
+(defmethod atanh ((x number))
(cl:atanh x))
-(defmethod qatanh ((x qd-real))
+(defmethod atanh ((x qd-real))
(if (> (abs x) 1)
(qd-complex-atanh x)
(make-instance 'qd-real :value (atanh-qd (qd-value x)))))
-
-(declaim (inline atanh))
-(defun atanh (x)
- (qatanh x))
-
-(defmethod qcis ((x real))
+(defmethod cis ((x real))
(cl:cis x))
-(defmethod qcis ((x qd-real))
+(defmethod cis ((x qd-real))
(multiple-value-bind (s c)
(sincos-qd (qd-value x))
(make-instance 'qd-complex
:real c
:imag s)))
-(declaim (inline cis))
-(defun cis (x)
- (qcis x))
-
-(defmethod qphase ((x number))
+(defmethod phase ((x number))
(cl:phase x))
-(defmethod qphase ((x qd-real))
+(defmethod phase ((x qd-real))
(if (minusp x)
(- +pi+)
(make-instance 'qd-real :value (make-qd-d 0d0))))
-(declaim (inline phase))
-(defun phase (x)
- (qphase x))
-
(defun signum (number)
"If NUMBER is zero, return NUMBER, else return (/ NUMBER (ABS NUMBER))."
(if (zerop number)
More information about the oct-cvs
mailing list