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

rtoy rtoy at common-lisp.net
Tue Sep 18 12:46:36 UTC 2007

Update of /project/oct/cvsroot/oct
In directory clnet:/tmp/cvs-serv7806

Modified Files:
	qd-complex.lisp qd-methods.lisp qd-package.lisp 
Log Message:
Add method RATIONAL to convert a quad-double to a rational.

o Appropriately shadow and export RATIONAL.
o Need to export WITH-QD-PARTS from QDI.

o Define methods for RATIONAL for reals and qd-reals.

o Use CL:RATIONAL as appropriate for the CL rational type. 

--- /project/oct/cvsroot/oct/qd-complex.lisp	2007/09/12 21:01:13	1.36
+++ /project/oct/cvsroot/oct/qd-complex.lisp	2007/09/18 12:46:36	1.37
@@ -35,27 +35,27 @@
 		 :real (sub-qd-d (qd-value (realpart a)) 1d0)
 		 :imag (qd-value (imagpart a))))
-(defmethod two-arg-/ ((a qd-real) (b rational))
+(defmethod two-arg-/ ((a qd-real) (b cl:rational))
   (make-instance 'qd-real :value (div-qd (qd-value a)
 					 (qd-value (float b #q0)))))
-(defmethod two-arg-/ ((a rational) (b qd-real))
+(defmethod two-arg-/ ((a cl:rational) (b qd-real))
   (make-instance 'qd-real :value (div-qd (qd-value (float a #q0))
 					 (qd-value b))))
-(defmethod two-arg-* ((a qd-real) (b rational))
+(defmethod two-arg-* ((a qd-real) (b cl:rational))
   (make-instance 'qd-real :value (mul-qd (qd-value a) (qd-value (float b #q0)))))
-(defmethod two-arg-+ ((a qd-real) (b rational))
+(defmethod two-arg-+ ((a qd-real) (b cl:rational))
   (make-instance 'qd-real :value (add-qd (qd-value a) (qd-value (float b #q0)))))
-(defmethod two-arg-+ ((a rational) (b qd-real))
+(defmethod two-arg-+ ((a cl:rational) (b qd-real))
   (make-instance 'qd-real :value (add-qd (qd-value b) (qd-value (float a #q0)))))
-(defmethod two-arg-- ((a qd-real) (b rational))
+(defmethod two-arg-- ((a qd-real) (b cl:rational))
   (make-instance 'qd-real :value (sub-qd (qd-value a) (qd-value (float b #q0)))))
-(defmethod two-arg-- ((a rational) (b qd-real))
+(defmethod two-arg-- ((a cl:rational) (b qd-real))
   (make-instance 'qd-real :value (sub-qd (qd-value (float a #q0)) (qd-value b))))
 (defmethod unary-minus ((z qd-complex))
--- /project/oct/cvsroot/oct/qd-methods.lisp	2007/09/16 02:39:29	1.57
+++ /project/oct/cvsroot/oct/qd-methods.lisp	2007/09/18 12:46:36	1.58
@@ -814,6 +814,16 @@
 (defmethod float-digits ((x qd-real))
   (* 4 (float-digits 1d0)))
+(defmethod rational ((x real))
+  (cl:rational x))
+(defmethod rational ((x qd-real))
+  (with-qd-parts (x0 x1 x2 x3)
+      (qd-value x)
+    (+ (cl:rational x0)
+       (cl:rational x1)
+       (cl:rational x2)
+       (cl:rational x3))))
 (define-compiler-macro + (&whole form &rest args)
   (if (null args)
--- /project/oct/cvsroot/oct/qd-package.lisp	2007/09/16 05:04:05	1.39
+++ /project/oct/cvsroot/oct/qd-package.lisp	2007/09/18 12:46:36	1.40
@@ -89,6 +89,7 @@
+	   #:with-qd-parts
   (:export #:add-qd-dd
@@ -166,6 +167,7 @@
+	   #:rational
   ;; Export types
   (:export #:qd-real
@@ -234,6 +236,7 @@
+	   #:rational
   ;; Constants
   (:export #:+pi+

More information about the oct-cvs mailing list