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

[rtoy]

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+