[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