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

Modified Files: qd-complex.lisp qd-methods.lisp qd-package.lisp Log Message: qd-package.lisp: o Rearrange some exports so the CMU ones are all grouped together. o Export new constants pi/2, pi/4, 2pi, and log2. o Export the qd-real and qd-complex types.

qd-methods.lisp: o Define new constants for pi/2, pi/4, 2pi, and log2. o Update some of the macrolets to work with a modern-mode lisp, like Allegro.

qd-complex.lisp: o Use the new constants as needed.

--- /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/31 21:13:36 1.35 +++ /project/oct/cvsroot/oct/qd-complex.lisp 2007/09/12 21:01:13 1.36 @@ -350,7 +350,7 @@ (let ((t0 (/ 1 (sqrt #q2.0q0))) (t1 #q1.2q0) (t2 #q3q0) - (ln2 #.(log #q2.0)) + (ln2 +log2+) (x (realpart z)) (y (imagpart z))) (multiple-value-bind (rho k) @@ -407,7 +407,7 @@ (let* ( ;; Constants (theta (/ (sqrt most-positive-double-float) 4.0d0)) (rho (/ 4.0d0 (sqrt most-positive-double-float))) - (half-pi #.(/ +pi+ 2d0)) + (half-pi +pi/2+) (rp (realpart z)) (beta (float-sign rp)) (x (* beta rp)) --- /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/31 21:13:36 1.55 +++ /project/oct/cvsroot/oct/qd-methods.lisp 2007/09/12 21:01:13 1.56 @@ -26,7 +26,24 @@ (in-package #:qd)

(defconstant +pi+ - (make-instance 'qd-real :value qdi:+qd-pi+)) + (make-instance 'qd-real :value qdi:+qd-pi+) + "Quad-double value of pi") + +(defconstant +pi/2+ + (make-instance 'qd-real :value qdi:+qd-pi/2+) + "Quad-double value of pi/2") + +(defconstant +pi/4+ + (make-instance 'qd-real :value qdi:+qd-pi/4+) + "Quad-double value of pi/4") + +(defconstant +2pi+ + (make-instance 'qd-real :value qdi:+qd-2pi+) + "Quad-double value of 2*pi") + +(defconstant +log2+ + (make-instance 'qd-real :value qdi:+qd-log2+) + "Quad-double value of log(2), natural log of 2")

#+cmu (defconstant +quad-double-float-positive-infinity+ @@ -200,9 +217,13 @@ (unary-divide number)))

(macrolet ((frob (name &optional (type 'real)) - (let ((method-name (intern (concatenate 'string "Q" (symbol-name name)))) + (let ((method-name (intern (concatenate 'string + (string '#:q) + (symbol-name name)))) (cl-name (intern (symbol-name name) :cl)) - (qd-name (intern (concatenate 'string (symbol-name name) "-QD")))) + (qd-name (intern (concatenate 'string + (symbol-name name) + (string '#:-qd))))) `(progn (defmethod ,method-name ((x ,type)) (,cl-name x)) @@ -318,9 +339,11 @@

(macrolet ((frob (op) - (let ((method (intern (concatenate 'string "TWO-ARG-" (symbol-name op)))) + (let ((method (intern (concatenate 'string + (string '#:two-arg-) + (symbol-name op)))) (cl-fun (find-symbol (symbol-name op) :cl)) - (qd-fun (intern (concatenate 'string "QD-" (symbol-name op)) + (qd-fun (intern (concatenate 'string (string '#:qd-) (symbol-name op)) (find-package :qdi)))) `(progn (defmethod ,method ((a real) (b real)) @@ -352,9 +375,11 @@ (macrolet ((frob (name) (let ((method-name - (intern (concatenate 'string "Q" (symbol-name name)))) + (intern (concatenate 'string (string '#:q) + (symbol-name name)))) (cl-name (intern (symbol-name name) :cl)) - (qd-name (intern (concatenate 'string (symbol-name name) "-QD")))) + (qd-name (intern (concatenate 'string (symbol-name name) + (string '#:-qd))))) `(progn (defmethod ,name ((x number)) (,cl-name x)) @@ -828,7 +853,9 @@ ;; the corresponding two-arg-<foo> function. (macrolet ((frob (op) - (let ((method (intern (concatenate 'string "TWO-ARG-" (symbol-name op))))) + (let ((method (intern (concatenate 'string + (string '#:two-arg-) + (symbol-name op))))) `(define-compiler-macro ,op (number &rest more-numbers) (do* ((n number (car nlist)) (nlist more-numbers (cdr nlist)) --- /project/oct/cvsroot/oct/qd-package.lisp 2007/08/29 01:22:03 1.36 +++ /project/oct/cvsroot/oct/qd-package.lisp 2007/09/12 21:01:13 1.37 @@ -30,11 +30,9 @@ #:read-qd #:add-qd #:add-qd-d - #:cmu #:add-qd-dd #:add-d-qd #:sub-qd #:sub-qd-d - #:cmu #:sub-qd-dd #:sub-d-qd #:neg-qd #:mul-qd @@ -42,9 +40,7 @@ #:sqr-qd #:div-qd #:div-qd-d - #+cmu #:div-qd-dd #:make-qd-d - #+cmu #:make-qd-dd #:integer-decode-qd #:npow #:qd-0 @@ -55,6 +51,10 @@ #:+qd-one+ #:+qd-zero+ #:+qd-pi+ + #:+qd-pi/2+ + #:+qd-pi/4+ + #:+qd-2pi+ + #:+qd-log2+ ;; Functions #:hypot-qd #:abs-qd @@ -91,6 +91,11 @@ #:random-qd ) #+cmu + (:export #:add-qd-dd + #:sub-qd-dd + #:div-qd-dd + #:make-qd-dd) + #+cmu (:import-from #:c #:two-sum #:quick-two-sum @@ -164,6 +169,10 @@ #:decf #:float-digits ) + ;; Export types + (:export #:qd-real + #:qd-complex) + ;; Export functions (:export #:+ #:- #:* @@ -229,7 +238,11 @@ #:float-digits ) ;; Constants - (:export #:+pi+) + (:export #:+pi+ + #:+pi/2+ + #:+pi/4+ + #:+2pi+ + #:+log2+) ;; CMUCL supports infinities. #+cmu (:export #:+quad-double-float-positive-infinity+