Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv28331
Modified Files: qd-complex.lisp qd-package.lisp Log Message: qd-complex.lisp: o Add ADD1 and SUB1 methods so we can use 1+ and 1- on quad-doubles. o Add INCF and DECF macros to support quad-doubles.
qd-package.lisp: o Forgot to shadow REALP, COMPLEXP, and NUMBERP, previously. o Shadow and export INCF and DECF.
--- /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/28 14:12:53 1.31 +++ /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/28 16:01:08 1.32 @@ -23,14 +23,16 @@ ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR ;;;; OTHER DEALINGS IN THE SOFTWARE.
-;; Most of this code taken from CMUCL and slightly modified to support -;; QD-COMPLEX. - (in-package #:qd)
(defmethod add1 ((a qd-complex)) (make-instance 'qd-complex - :real (qd-value (add1 (realpart a))) + :real (add-qd-d (qd-value (realpart a)) 1d0) + :imag (qd-value (imagpart a)))) + +(defmethod sub1 ((a qd-complex)) + (make-instance 'qd-complex + :real (sub-qd-d (qd-value (realpart a)) 1d0) :imag (qd-value (imagpart a)))) (defmethod two-arg-/ ((a qd-real) (b rational)) @@ -230,6 +232,33 @@ (defmethod coerce ((number qd-complex) (type (eql 'qd-complex))) number)
+;; These two macros are borrowed from CMUCL. +(defmacro incf (place &optional (delta 1) &environment env) + "The first argument is some location holding a number. This number is + incremented by the second argument, DELTA, which defaults to 1." + (multiple-value-bind (dummies vals newval setter getter) + (get-setf-expansion place env) + (let ((d (gensym))) + `(let* (,@(mapcar #'list dummies vals) + (,d ,delta) + (,(car newval) (+ ,getter ,d))) + ,setter)))) + +(defmacro decf (place &optional (delta 1) &environment env) + "The first argument is some location holding a number. This number is + decremented by the second argument, DELTA, which defaults to 1." + (multiple-value-bind (dummies vals newval setter getter) + (get-setf-expansion place env) + (let ((d (gensym))) + `(let* (,@(mapcar #'list dummies vals) + (,d ,delta) + (,(car newval) (- ,getter ,d))) + ,setter)))) + + +;; Most of this code taken from CMUCL and slightly modified to support +;; QD-COMPLEX. + (declaim (inline square)) (defun square (x) (declare (type qd-real x)) @@ -604,6 +633,7 @@ (result (qd-complex-tanh iz))) (complex (imagpart result) (- (realpart result))))) +;; End of implementation of complex functions from CMUCL. (defmethod qasin ((x qd-complex)) (qd-complex-asin x)) --- /project/oct/cvsroot/oct/qd-package.lisp 2007/08/28 00:56:18 1.34 +++ /project/oct/cvsroot/oct/qd-package.lisp 2007/08/28 16:01:08 1.35 @@ -157,6 +157,11 @@ #:signum #:coerce #:random + #:realp + #:complexp + #:numberp + #:incf + #:decf ) (:export #:+ #:- @@ -218,6 +223,8 @@ #:realp #:complexp #:numberp + #:incf + #:decf ) ;; Constants (:export #:+pi+)