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

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))
participants (1)
-
rtoy