[lisplab-cvs] r211 - in trunk/src: core matrix2

[jivestgarden at common-lisp.net]

Author: jivestgarden
Date: Sat Mar 24 12:32:20 2012
New Revision: 211

Log:
the ordinary functions now outputs double float when input integer

Modified:
   trunk/src/core/level0-functions.lisp
   trunk/src/matrix2/matrix2-constructors.lisp

Modified: trunk/src/core/level0-functions.lisp
==============================================================================
--- trunk/src/core/level0-functions.lisp	Fri Mar 23 12:19:57 2012	(r210)
+++ trunk/src/core/level0-functions.lisp	Sat Mar 24 12:32:20 2012	(r211)
@@ -121,13 +121,7 @@
 
 
 (define-constant +ordinary-functions-number-to-number-map+ 
-  '((.sin . sin) (.cos . cos) (.tan . tan)
-    (.asin . asin) (.acos . acos) (.atan . atan)
-    (.sinh . sinh) (.cosh . cosh) (.tanh . tanh)
-    (.asinh . asinh) (.acosh . acosh) (.atanh . atanh)
-    (.exp . exp) (.ln . log) 
-    (.sqrt . sqrt) (.sqr . sqr)
-    (.re . realpart)(.im . imagpart) (.abs . abs)
+  '((.re . realpart)(.im . imagpart) (.abs . abs)
     (.conj . conjugate)))
 
 (defmacro expand-num-num ()
@@ -141,6 +135,28 @@
 
 (expand-num-num)
 
+(define-constant +ordinary-functions-number-to-real-map+ 
+  '((.sin . sin) (.cos . cos) (.tan . tan)
+    (.asin . asin) (.acos . acos) (.atan . atan)
+    (.sinh . sinh) (.cosh . cosh) (.tanh . tanh)
+    (.asinh . asinh) (.acosh . acosh) (.atanh . atanh)
+    (.exp . exp) (.ln . log) 
+    (.sqrt . sqrt) (.sqr . sqr)))
+
+(defmacro expand-num-real ()
+  ;; TODO: optimize? why?
+  (cons 'progn
+      (mapcar (lambda (name)
+		`(progn 
+		   (defmethod ,(car name) ((a number))
+		     (,(cdr name) 
+		       (if (integerp a) 
+			   (coerce a 'double-float)
+			   a)))))
+	      +ordinary-functions-number-to-real-map+ )))
+
+(expand-num-real)
+
 
 
 

Modified: trunk/src/matrix2/matrix2-constructors.lisp
==============================================================================
--- trunk/src/matrix2/matrix2-constructors.lisp	Fri Mar 23 12:19:57 2012	(r210)
+++ trunk/src/matrix2/matrix2-constructors.lisp	Sat Mar 24 12:32:20 2012	(r211)
@@ -216,7 +216,7 @@
 			   (funcall fun i j))
 		   :vref (lambda (self i)
 			   (declare (ignore self))
-			   (multiple-value-bind (c r)			       
+			   (multiple-value-bind (c r)
 			       (floor i rows)
 			     (funcall fun r c))))))