[oct-cvs] Oct commit: oct qd-complex.lisp qd-package.lisp

[rtoy]

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+)