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)