[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.
qd-package.lisp:
o Appropriately shadow and export RATIONAL.
o Need to export WITH-QD-PARTS from QDI.
qd-methods.lisp:
o Define methods for RATIONAL for reals and qd-reals.
qd-complex.lisp:
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 @@
#:scale-float-qd
#:ffloor-qd
#:random-qd
+ #:with-qd-parts
)
#+cmu
(:export #:add-qd-dd
@@ -166,6 +167,7 @@
#:incf
#:decf
#:float-digits
+ #:rational
)
;; Export types
(:export #:qd-real
@@ -234,6 +236,7 @@
#:incf
#:decf
#:float-digits
+ #:rational
)
;; Constants
(:export #:+pi+
More information about the oct-cvs
mailing list