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

rtoy rtoy at common-lisp.net
Sat Aug 25 02:08:04 UTC 2007


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

Modified Files:
	qd-methods.lisp qd-package.lisp 
Log Message:
qd-package.lisp:
o Shadow CL:COERCE and export QD:COERCE

qd-methods.lisp:
o Define methods for COERCE so we can use COERCE with QD-REAL and
  QD-COMPLEX. 


--- /project/oct/cvsroot/oct/qd-methods.lisp	2007/08/24 21:45:16	1.44
+++ /project/oct/cvsroot/oct/qd-methods.lisp	2007/08/25 02:08:04	1.45
@@ -775,6 +775,23 @@
 	  (if (plusp number) 1 -1)
 	  (/ number (abs number)))))
 
+(defmethod coerce ((obj t) (type t))
+  (cl:coerce obj type))
+
+(defmethod coerce ((number cl:real) (type (eql 'qd-real)))
+  (float number #q0))
+
+(defmethod coerce ((number qd-real) (type (eql 'qd-real)))
+  number)
+
+(defmethod coerce ((number cl:number) (type (eql 'qd-complex)))
+  (complex (float (realpart number) #q0)
+	   (float (imagpart number) #q0)))
+
+(defmethod coerce ((number qd-complex) (type (eql qd-complex)))
+  number)
+
+
 (define-compiler-macro + (&whole form &rest args)
   (if (null args)
       0
--- /project/oct/cvsroot/oct/qd-package.lisp	2007/08/24 20:35:46	1.30
+++ /project/oct/cvsroot/oct/qd-package.lisp	2007/08/25 02:08:04	1.31
@@ -131,6 +131,7 @@
 	   #:cis
 	   #:phase
 	   #:signum
+	   #:coerce
 	   )
   (:export #:+
 	   #:-
@@ -187,6 +188,7 @@
 	   #:cis
 	   #:phase
 	   #:signum
+	   #:coerce
 	   )
   ;; Constants
   (:export #:+pi+)




More information about the oct-cvs mailing list