[cl-gsl-cvs] CVS update: cl-gsl/vector.lisp

[cl-gsl-cvs at common-lisp.net]

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
+          , at 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
+          , at body
+       (free ,vec-dest))))
 
 
 (defun swap (va vb)