Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv30732
Modified Files: vector.lisp Log Message: Add macros that automatically free foreign objects.
Date: Mon Apr 4 02:47:40 2005 Author: edenny
Index: cl-gsl/vector.lisp diff -u cl-gsl/vector.lisp:1.4 cl-gsl/vector.lisp:1.5 --- cl-gsl/vector.lisp:1.4 Tue Mar 15 04:17:29 2005 +++ cl-gsl/vector.lisp Mon Apr 4 02:47:39 2005 @@ -345,11 +345,11 @@ ((eq (gsl-vec-element-type v) 'double-float) (gsl-vector-set (gsl-vec-ptr v) i x)) ((equal (gsl-vec-element-type v) '(complex (single-float))) - (wrap-gsl-vector-complex-float-set (gsl-vec-ptr v) i - (complex->gsl-complex-float-ptr x))) + (with-complex-single-float->gsl-complex-float-ptr (c-ptr x) + (wrap-gsl-vector-complex-float-set (gsl-vec-ptr v) i c-ptr))) ((equal (gsl-vec-element-type v) '(complex (double-float))) - (wrap-gsl-vector-complex-set (gsl-vec-ptr v) i - (complex->gsl-complex-ptr x))) + (with-complex-double-float->gsl-complex-ptr (c-ptr x) + (wrap-gsl-vector-complex-set (gsl-vec-ptr v) i c-ptr))) (t (error "No matching type"))))
@@ -365,11 +365,11 @@ ((eq (gsl-vec-element-type v) 'double-float) (gsl-vector-set-all (gsl-vec-ptr v) x)) ((equal (gsl-vec-element-type v) '(complex (single-float))) - (wrap-gsl-vector-complex-float-set-all (gsl-vec-ptr v) - (complex->gsl-complex-float-ptr x))) + (with-complex-single-float->gsl-complex-float-ptr (c-ptr x) + (wrap-gsl-vector-complex-float-set-all (gsl-vec-ptr v) c-ptr))) ((equal (gsl-vec-element-type v) '(complex (double-float))) - (wrap-gsl-vector-complex-set-all (gsl-vec-ptr v) - (complex->gsl-complex-ptr x))) + (with-complex-double-float->gsl-complex-ptr (c-ptr x) + (wrap-gsl-vector-complex-set-all (gsl-vec-ptr v) c-ptr))) (t (error "No matching type"))))
@@ -439,6 +439,17 @@ v))
+(defmacro with-vector ((vec size &key element-type initial-element + initial-contents) &body body) + `(let ((,vec (make-vector ,size + :element-type (or ,element-type 'double-float) + :initial-element ,initial-element + :initial-contents ,initial-contents))) + (unwind-protect + ,@body + (free ,vec)))) + + (defun write-to-binary-file (file-name v) (assert (eq 'gsl-vec (type-of v))) (let ((status)) @@ -608,6 +619,13 @@ (t (error "No matching type"))))) (values v-dest status))) + + +(defmacro with-vector-copy ((vec-dest vec-src) &body body) + `(let ((,vec-dest (copy ,vec-src))) + (unwind-protect + ,@body + (free ,vec-dest))))
(defun swap (va vb)