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

[rtoy]

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

Modified Files:
	qd-class.lisp qd-methods.lisp 
Log Message:
MAKE-QD should handle rationals better instead of converting them to
doubles and then converting the qd-real.  Convert the numerator and
denominator to qd-real, and the divide.  (This should be done better.)

qd-class.lisp:
o Change method to work on floats, instead of reals.

qd-methods.lisp:
o Add method to handle rationals.


--- /project/oct/cvsroot/oct/qd-class.lisp	2007/09/06 02:58:38	1.25
+++ /project/oct/cvsroot/oct/qd-class.lisp	2007/09/19 17:30:04	1.26
@@ -60,7 +60,7 @@
 (defmethod print-object ((qd qd-real) stream)
   (print-qd (qd-value qd) stream))
 
-(defmethod make-qd ((x real))
+(defmethod make-qd ((x cl:float))
   (make-instance 'qd-real :value (make-qd-d (float x 1d0))))
 
 (defmethod make-qd ((x qd-real))
--- /project/oct/cvsroot/oct/qd-methods.lisp	2007/09/18 12:46:36	1.58
+++ /project/oct/cvsroot/oct/qd-methods.lisp	2007/09/19 17:30:04	1.59
@@ -76,6 +76,16 @@
 (defconstant +qd-real-one+
   (make-instance 'qd-real :value (make-qd-d 1d0)))
 
+
+(defmethod make-qd ((x cl:rational))
+  ;; We should do something better than this.
+  (let ((top (numerator x))
+	(bot (denominator x)))
+    (make-instance 'qd-real
+		   :value (div-qd (qdi::make-float (signum top) (abs top) 0 0 0)
+				  (qdi::make-float (signum bot) (abs bot) 0 0 0)))))
+
+
 (defmethod add1 ((a number))
   (cl::1+ a))
 
@@ -824,8 +834,10 @@
        (cl:rational x1)
        (cl:rational x2)
        (cl:rational x3))))
+
 
 (define-compiler-macro + (&whole form &rest args)
+  (declare (ignore form))
   (if (null args)
       0
       (do ((args (cdr args) (cdr args))
@@ -834,6 +846,7 @@
 	  ((null args) res))))
 
 (define-compiler-macro - (&whole form number &rest more-numbers)
+  (declare (ignore form))
   (if more-numbers
       (do ((nlist more-numbers (cdr nlist))
 	   (result number))
@@ -843,6 +856,7 @@
       `(unary-minus ,number)))
 
 (define-compiler-macro * (&whole form &rest args)
+  (declare (ignore form))
   (if (null args)
       1
       (do ((args (cdr args) (cdr args))