[lisplab-cvs] r185 - in trunk/src: core specfunc vector1

Jørn Inge Vestgården jivestgarden at common-lisp.net
Sat Oct 2 15:29:26 UTC 2010


Author: jivestgarden
Date: Sat Oct  2 11:29:26 2010
New Revision: 185

Log:
minor cleanup

Modified:
   trunk/src/core/level0-basic.lisp
   trunk/src/specfunc/level0-specfunc.lisp
   trunk/src/vector1/level1-vector.lisp

Modified: trunk/src/core/level0-basic.lisp
==============================================================================
--- trunk/src/core/level0-basic.lisp	(original)
+++ trunk/src/core/level0-basic.lisp	Sat Oct  2 11:29:26 2010
@@ -28,13 +28,6 @@
 ;; Help, not tested
 #-sbcl(defmacro truely-the (type val) `(the ,type ,val))
 
-;; (setf *READ-DEFAULT-FLOAT-FORMAT* 'double-float) ; TODO make part of pacakge import?
-
-(defmacro with-gensyms ((&rest names) . body)
-  ;; TODO remove? Is it used at all?
-  `(let ,(loop for n in names collect `(,n (gensym)))
-     , at body))
-
 (defmacro define-constant (name value &optional doc)
   "Works as defconstant. Made to avoid trouble with sbcl's strict
 interpretation of the ansi standard."
@@ -52,7 +45,7 @@
   "Coerce x to double float."
   (coerce x 'double-float))
 
-(defun dvec (n)
+(defun make-dvec (n)
   "Creates a double vector with n elements."
   (make-array n :element-type 'double-float :initial-element 0d0))
 

Modified: trunk/src/specfunc/level0-specfunc.lisp
==============================================================================
--- trunk/src/specfunc/level0-specfunc.lisp	(original)
+++ trunk/src/specfunc/level0-specfunc.lisp	Sat Oct  2 11:29:26 2010
@@ -27,15 +27,15 @@
   (typecase x 
     (complex (let ((rx (to-df (realpart x)))
 		   (cx (to-df (imagpart x)))
-		   (ry (dvec 1))
-		   (cy (dvec 1)))
+		   (ry (make-dvec 1))
+		   (cy (make-dvec 1)))
 	       (slatec:zbesj rx cx (to-df n) 1 1 ry cy 0 0)
 	       (complex (aref ry 0) (aref cy 0))))
     (t (let ((x (to-df x)))
 	 (case n 
 	   (0 (slatec:dbesj0 x))
 	   (1 (slatec:dbesj1 x))
-	   (t (let ((y (dvec 1)))
+	   (t (let ((y (make-dvec 1)))
 		(slatec:dbesj x (to-df n) 1 y 0)
 		(aref y 0))))))))
 
@@ -46,17 +46,17 @@
    (typecase x 
     (complex (let ((rx (to-df (realpart x)))
 		   (cx (to-df (imagpart x)))
-		   (ry (dvec 1))
-		   (cy (dvec 1))
-		   (rw (dvec 1))
-		   (cw (dvec 1)))
+		   (ry (make-dvec 1))
+		   (cy (make-dvec 1))
+		   (rw (make-dvec 1))
+		   (cw (make-dvec 1)))
 	       (slatec:zbesy rx cx (to-df n) 1 1 ry cy 0 rw cw 0)
 	       (complex (aref ry 0) (aref cy 0))))
     (t (let ((x (to-df x)))
 	 (case n 
 	   (0 (slatec:dbesy0 x))
 	   (1 (slatec:dbesy1 x))
-	   (t (let ((y (dvec 1)))
+	   (t (let ((y (make-dvec 1)))
 		(slatec:dbesy x (to-df n) 1 y)
 		(aref y 0))))))))
 
@@ -67,15 +67,15 @@
   (typecase x 
     (complex (let ((rx (to-df (realpart x)))
 		   (cx (to-df (imagpart x)))
-		   (ry (dvec 1))
-		   (cy (dvec 1)))
+		   (ry (make-dvec 1))
+		   (cy (make-dvec 1)))
 	       (slatec:zbesi  rx cx (to-df n) 1 1 ry cy 0 0)
 	       (complex (aref ry 0) (aref cy 0))))
     (t (let ((x (to-df x)))
 	 (case n 
 	   (0 (slatec:dbesi0 x))
 	   (1 (slatec:dbesi1 x))
-	   (t (let ((y (dvec 1)))
+	   (t (let ((y (make-dvec 1)))
 		(slatec:dbesi x (to-df n) 1 1 y 0)
 		(aref y 0))))))))
 
@@ -86,15 +86,15 @@
   (typecase x 
     (complex (let ((rx (to-df (realpart x)))
 		   (cx (to-df (imagpart x)))
-		   (ry (dvec 1))
-		   (cy (dvec 1)))
+		   (ry (make-dvec 1))
+		   (cy (make-dvec 1)))
 	       (slatec:zbesk rx cx (to-df n) 1 1 ry cy 0 0)
 	       (complex (aref ry 0) (aref cy 0))))
     (t (let ((x (to-df x)))
 	 (case n 
 	   (0 (slatec:dbesk0 x))
 	   (1 (slatec:dbesk1 x))
-	   (t (let ((y (dvec 1)))
+	   (t (let ((y (make-dvec 1)))
 		(slatec:dbesk x (to-df n) 1 1 y 0)
 		(aref y 0))))))))
 
@@ -104,8 +104,8 @@
   ;; TODO: what about negaive n, negative x and complex n?
   (let ((rx (to-df (realpart x)))
 	(cx (to-df (imagpart x)))
-	(ry (dvec 1))
-	(cy (dvec 1)))
+	(ry (make-dvec 1))
+	(cy (make-dvec 1)))
     (slatec:zbesh rx cx (to-df n) 1 1 1 ry cy 0 0 )
     (complex (aref ry 0) (aref cy 0))))
 
@@ -115,8 +115,8 @@
   ;; TODO: what about negaive n, negative x and complex n?
   (let ((rx (to-df (realpart x)))
 	(cx (to-df (imagpart x)))
-	(ry (dvec 1))
-	(cy (dvec 1)))
+	(ry (make-dvec 1))
+	(cy (make-dvec 1)))
     (slatec:zbesh rx cx (to-df n) 1 2 1 ry cy 0 0 )
     (complex (aref ry 0) (aref cy 0))))
 

Modified: trunk/src/vector1/level1-vector.lisp
==============================================================================
--- trunk/src/vector1/level1-vector.lisp	(original)
+++ trunk/src/vector1/level1-vector.lisp	Sat Oct  2 11:29:26 2010
@@ -48,6 +48,11 @@
 
 ;;; General
 
+(defmethod print-object ((v vector-base) stream)
+  (print-unreadable-object (v stream :type t :identity t)
+    (dotimes (i (min (size v) *lisplab-print-size*))
+      (format stream "~a " (vref v i)))))
+
 (defmethod vector-p ((x vector-base)) t)
 
 (defmethod rank ((x vector-base)) 




More information about the lisplab-cvs mailing list