[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