Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv328
Modified Files: vector.lisp Log Message: Make file actually compile.
Date: Fri Mar 4 02:56:04 2005 Author: edenny
Index: cl-gsl/vector.lisp diff -u cl-gsl/vector.lisp:1.1.1.1 cl-gsl/vector.lisp:1.2 --- cl-gsl/vector.lisp:1.1.1.1 Wed Mar 2 02:04:53 2005 +++ cl-gsl/vector.lisp Fri Mar 4 02:56:03 2005 @@ -107,63 +107,89 @@ ((v1 ,type-ptr)) :int)
- (defun-foreign ,(concatenate 'string "gsl_" type-string "_add") - ((va ,type-ptr) - (vb ,type-ptr)) - :int) - - (defun-foreign ,(concatenate 'string "gsl_" type-string "_sub") - ((va ,type-ptr) - (vb ,type-ptr)) - :int) - - (defun-foreign ,(concatenate 'string "gsl_" type-string "_mul") - ((va ,type-ptr) - (vb ,type-ptr)) - :int) - - (defun-foreign ,(concatenate 'string "gsl_" type-string "_div") - ((va ,type-ptr) - (vb ,type-ptr)) - :int) - - (defun-foreign ,(concatenate 'string "gsl_" type-string "_scale") - ((vec ,type-ptr) - (x ,type-val)) - :int) - - (defun-foreign ,(concatenate 'string "gsl_" type-string "_add_constant") - ((vec ,type-ptr) - (x ,type-val)) - :int) - - (defun-foreign ,(concatenate 'string "gsl_" type-string "_max") - ((vec ,type-ptr)) - ,type-val) - - (defun-foreign ,(concatenate 'string "gsl_" type-string "_min") - ((vec ,type-ptr)) - ,type-val) - - (defun-foreign ,(concatenate 'string "gsl_" type-string "_minmax") - ((vec ,type-ptr) - (min ,type-val-ptr) - (max ,type-val-ptr)) - :void) - - (defun-foreign ,(concatenate 'string "gsl_" type-string "_max_index") - ((vec ,type-ptr)) - size-t) - - (defun-foreign ,(concatenate 'string "gsl_" type-string "_min_index") - ((vec ,type-ptr)) - size-t) - - (defun-foreign ,(concatenate 'string "gsl_" type-string "_minmax_index") - ((vec ,type-ptr) - (min size-t-ptr) - (max size-t-ptr)) - :void) + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string "gsl_" type-string "_add") + ((va ,type-ptr) + (vb ,type-ptr)) + :int)) + + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string "gsl_" type-string "_sub") + ((va ,type-ptr) + (vb ,type-ptr)) + :int)) + + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string "gsl_" type-string "_mul") + ((va ,type-ptr) + (vb ,type-ptr)) + :int)) + + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string "gsl_" type-string "_div") + ((va ,type-ptr) + (vb ,type-ptr)) + :int)) + + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string "gsl_" type-string "_scale") + ((vec ,type-ptr) + (x ,type-val)) + :int)) + + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string + "gsl_" type-string "_add_constant") + ((vec ,type-ptr) + (x ,type-val)) + :int)) + + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string "gsl_" type-string "_max") + ((vec ,type-ptr)) + ,type-val)) + + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string "gsl_" type-string "_min") + ((vec ,type-ptr)) + ,type-val)) + + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string "gsl_" type-string "_minmax") + ((vec ,type-ptr) + (min ,type-val-ptr) + (max ,type-val-ptr)) + :void)) + + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string "gsl_" type-string "_max_index") + ((vec ,type-ptr)) + size-t)) + + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string "gsl_" type-string "_min_index") + ((vec ,type-ptr)) + size-t)) + + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string + "gsl_" type-string "_minmax_index") + ((vec ,type-ptr) + (min size-t-ptr) + (max size-t-ptr)) + :void))
(defun-foreign ,(concatenate 'string "gsl_" type-string "_isnull") ((vec ,type-ptr)) @@ -218,7 +244,7 @@ element-type)
(defun alloc (v) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (ecase (gsl-vec-element-type v) ('integer (setf (gsl-vec-ptr v) (gsl-vector-int-alloc (gsl-vec-size v)))) @@ -233,7 +259,7 @@
(defun free (v) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (ecase (gsl-vec-element-type v) ('integer (gsl-vector-int-free (gsl-vec-ptr v))) @@ -251,7 +277,7 @@
(defun get-element (v i) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (assert (typep i 'integer)) (assert (< i (gsl-vec-size v))) (ecase (gsl-vec-element-type v) @@ -269,7 +295,7 @@
(defun set-element (v i x) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (assert (eq (type-of x) (gsl-vec-element-type v))) (assert (typep i 'integer)) (assert (< i (gsl-vec-size v))) @@ -291,7 +317,7 @@
(defun set-all (v x) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (assert (eq (type-of x) (gsl-vec-element-type v))) (ecase (gsl-vec-element-type v) ('integer @@ -308,7 +334,7 @@ (complex->gsl-complex x)))))
(defun set-zero (v) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (ecase (gsl-vec-element-type v) ('integer (gsl-vector-int-set-zero (gsl-vec-ptr v))) @@ -317,15 +343,13 @@ ('double-float (gsl-vector-set-zero (gsl-vec-ptr v))) ('complex-single-float - (gsl-vector-complex-float-set-zero (gsl-vec-ptr v) - (complex->gsl-complex-float))) + (gsl-vector-complex-float-set-zero (gsl-vec-ptr v))) ('complex-double-float - (gsl-vector-complex-set-zero (gsl-vec-ptr v) - (complex->gsl-complex))))) + (gsl-vector-complex-set-zero (gsl-vec-ptr v)))))
(defun set-basis (v i) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (assert (typep i 'integer)) (assert (< i (gsl-vec-size v))) (ecase (gsl-vec-element-type v) @@ -349,7 +373,7 @@ (assert (find element-type '(integer single-float double-float complex-single-float double-single-float))) (let ((v (make-gsl-vec :size size :element-type element-type))) - (setf (gsl-vec-ptr v) (gsl-vector:alloc v)) + (setf (gsl-vec-ptr v) (alloc v)) (cond ((and initial-element initial-contents) (error "cannot define both initial-element and initial-contents keys")) @@ -372,83 +396,86 @@
(defun write-to-binary-file (file-name v) - (declare (gsl-vector v)) + (assert (eq 'gsl (type-of v))) (let ((status)) - (with-cstring (c-file-name file-name) + (uffi:with-cstring (c-file-name file-name) (setq status (ecase (gsl-vec-element-type v) ('integer (wrap-gsl-vector-int-fwrite c-file-name (gsl-vec-ptr v))) ('single-float - (gsl-vector-float-fwrite c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-float-fwrite c-file-name (gsl-vec-ptr v))) ('double-float - (gsl-vector-fwrite c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-fwrite c-file-name (gsl-vec-ptr v))) ('complex-single-float - (gsl-vector-complex-float-fwrite c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-complex-float-fwrite c-file-name + (gsl-vec-ptr v))) ('complex-double-float - (gsl-vector-complex-fwrite c-file-name (gsl-vec-ptr v)))))) + (wrap-gsl-vector-complex-fwrite c-file-name (gsl-vec-ptr v)))))) status))
(defun write-to-file (file-name v) - (declare (gsl-vector v)) + (assert (eq 'gsl (type-of v))) (let ((status)) - (with-cstring (c-file-name file-name) + (uffi:with-cstring (c-file-name file-name) (setq status (ecase (gsl-vec-element-type v) ('integer (wrap-gsl-vector-int-fprintf c-file-name (gsl-vec-ptr v))) ('single-float - (gsl-vector-float-fprintf c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-float-fprintf c-file-name (gsl-vec-ptr v))) ('double-float - (gsl-vector-fprintf c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-fprintf c-file-name (gsl-vec-ptr v))) ('complex-single-float - (gsl-vector-complex-float-fprintf c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-complex-float-fprintf c-file-name + (gsl-vec-ptr v))) ('complex-double-float - (gsl-vector-complex-fprintf c-file-name (gsl-vec-ptr v)))))) + (wrap-gsl-vector-complex-fprintf c-file-name (gsl-vec-ptr v)))))) status))
(defun read-from-binary-file (file-name size element-type) - (let ((v (make-vector :size size :element-type element-type)) + (let ((v (make-vector size :element-type element-type)) (status)) - (with-cstring (c-file-name file-name) + (uffi:with-cstring (c-file-name file-name) (setq status (ecase (gsl-vec-element-type v) ('integer (wrap-gsl-vector-int-fread c-file-name (gsl-vec-ptr v))) ('single-float - (gsl-vector-float-fread c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-float-fread c-file-name (gsl-vec-ptr v))) ('double-float - (gsl-vector-fread c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-fread c-file-name (gsl-vec-ptr v))) ('complex-single-float - (gsl-vector-complex-float-fread c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-complex-float-fread c-file-name (gsl-vec-ptr v))) ('complex-double-float - (gsl-vector-complex-fread c-file-name (gsl-vec-ptr v)))))) + (wrap-gsl-vector-complex-fread c-file-name (gsl-vec-ptr v)))))) (values v status)))
(defun read-from-file (file-name size element-type) - (let ((v (make-vector :size size :element-type element-type)) + (let ((v (make-vector size :element-type element-type)) (status)) - (with-cstring (c-file-name file-name) + (uffi:with-cstring (c-file-name file-name) (setq status (ecase (gsl-vec-element-type v) ('integer (wrap-gsl-vector-int-fscanf c-file-name (gsl-vec-ptr v))) ('single-float - (gsl-vector-float-fscanf c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-float-fscanf c-file-name (gsl-vec-ptr v))) ('double-float - (gsl-vector-fscanf c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-fscanf c-file-name (gsl-vec-ptr v))) ('complex-single-float - (gsl-vector-complex-float-fscanf c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-complex-float-fscanf c-file-name + (gsl-vec-ptr v))) ('complex-double-float - (gsl-vector-complex-fscanf c-file-name (gsl-vec-ptr v)))))) + (wrap-gsl-vector-complex-fscanf c-file-name (gsl-vec-ptr v)))))) (values v status)))
(defun subvector (v offset n) - (declare (gsl-vector v)) + (assert (eq 'gsl (type-of v))) (assert (typep offset 'integer)) (assert (typep n 'integer)) (assert (< (+ offset n) (gsl-vec-size v))) @@ -471,7 +498,7 @@
(defun subvector-with-stride (v offset stride n) - (declare (gsl-vector v)) + (assert (eq 'gsl (type-of v))) (assert (typep offset 'integer)) (assert (typep stride 'integer)) (assert (typep n 'integer)) @@ -500,8 +527,8 @@
(defun copy (v-src) - (let* ((v-dest (make-vector :size (gsl-vec-size v-src) - :element-type (gsl-vec-element-type v-src))) + (let* ((v-dest (make-vector (gsl-vec-size v-src) + :element-type (gsl-vec-element-type v-src))) (status (ecase (gsl-vec-element-type v-src) ('integer (gsl-vector-int-memcpy (gsl-vec-ptr v-dest) @@ -522,7 +549,8 @@
(defun swap (va vb) - (declare (gsl-vec va) (gsl-vec vb)) + (assert (eq 'gsl (type-of va))) + (assert (eq 'gsl (type-of vb))) (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb))) (assert (= (gsl-vec-size va) (gsl-vec-size vb))) (let ((status @@ -541,7 +569,7 @@
(defun swap-elements (v i j) - (declare (gsl-vec v) (integer i) (integer j)) + (assert (eq 'gsl (type-of v))) (assert (typep i 'integer)) (assert (typep j 'integer)) (assert (< i (gsl-vec-size v))) @@ -562,7 +590,7 @@
(defun reverse-vector (v) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (let ((status (ecase (gsl-vec-element-type v) ('integer @@ -579,7 +607,8 @@
(defun add (va vb) - (declare (gsl-vec va) (gsl-vec vb)) + (assert (eq 'gsl (type-of va))) + (assert (eq 'gsl (type-of vb))) (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb))) (assert (= (gsl-vec-size va) (gsl-vec-size vb))) (let ((status @@ -589,16 +618,13 @@ ('single-float (gsl-vector-float-add (gsl-vec-ptr va) (gsl-vec-ptr vb))) ('double-float - (gsl-vector-add (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('complex-single-float - (gsl-vector-complex-float-add (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('complex-double-float - (gsl-vector-complex-add (gsl-vec-ptr va) (gsl-vec-ptr vb)))))) + (gsl-vector-add (gsl-vec-ptr va) (gsl-vec-ptr vb)))))) (values va status)))
(defun sub (va vb) - (declare (gsl-vec va) (gsl-vec vb)) + (assert (eq 'gsl (type-of va))) + (assert (eq 'gsl (type-of vb))) (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb))) (assert (= (gsl-vec-size va) (gsl-vec-size vb))) (let ((status @@ -608,15 +634,12 @@ ('single-float (gsl-vector-float-sub (gsl-vec-ptr va) (gsl-vec-ptr vb))) ('double-float - (gsl-vector-sub (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('complex-single-float - (gsl-vector-complex-float-sub (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('complex-double-float - (gsl-vector-complex-sub (gsl-vec-ptr va) (gsl-vec-ptr vb)))))) + (gsl-vector-sub (gsl-vec-ptr va) (gsl-vec-ptr vb)))))) (values va status)))
(defun mul (va vb) - (declare (gsl-vec va) (gsl-vec vb)) + (assert (eq 'gsl (type-of va))) + (assert (eq 'gsl (type-of vb))) (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb))) (assert (= (gsl-vec-size va) (gsl-vec-size vb))) (let ((status @@ -626,16 +649,13 @@ ('single-float (gsl-vector-float-mul (gsl-vec-ptr va) (gsl-vec-ptr vb))) ('double-float - (gsl-vector-mul (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('complex-single-float - (gsl-vector-complex-float-mul (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('complex-double-float - (gsl-vector-complex-mul (gsl-vec-ptr va) (gsl-vec-ptr vb)))))) + (gsl-vector-mul (gsl-vec-ptr va) (gsl-vec-ptr vb)))))) (values va status)))
(defun div (va vb) - (declare (gsl-vec va) (gsl-vec vb)) + (assert (eq 'gsl (type-of va))) + (assert (eq 'gsl (type-of vb))) (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb))) (assert (= (gsl-vec-size va) (gsl-vec-size vb))) (let ((status @@ -645,16 +665,12 @@ ('single-float (gsl-vector-float-div (gsl-vec-ptr va) (gsl-vec-ptr vb))) ('double-float - (gsl-vector-div (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('complex-single-float - (gsl-vector-complex-float-div (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('complex-double-float - (gsl-vector-complex-div (gsl-vec-ptr va) (gsl-vec-ptr vb)))))) + (gsl-vector-div (gsl-vec-ptr va) (gsl-vec-ptr vb)))))) (values va status)))
(defun scale (v x) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (assert (eq (gsl-vec-element-type v) (type-of x))) (let ((status (ecase (gsl-vec-element-type v) @@ -663,16 +679,12 @@ ('single-float (gsl-vector-float-scale (gsl-vec-ptr v) x)) ('double-float - (gsl-vector-scale (gsl-vec-ptr v) x)) - ('complex-single-float - (gsl-vector-complex-float-scale (gsl-vec-ptr v) x)) - ('complex-double-float - (gsl-vector-complex-scale (gsl-vec-ptr v) x))))) + (gsl-vector-scale (gsl-vec-ptr v) x))))) (values v status)))
(defun add-constant (v x) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (assert (eq (gsl-vec-element-type v) (type-of x))) (let ((status (ecase (gsl-vec-element-type v) @@ -681,98 +693,73 @@ ('single-float (gsl-vector-float-add-constant (gsl-vec-ptr v) x)) ('double-float - (gsl-vector-add-constant (gsl-vec-ptr v) x)) - ('complex-single-float - (gsl-vector-complex-float-add-constant (gsl-vec-ptr v) x)) - ('complex-double-float - (gsl-vector-complex-add-constant (gsl-vec-ptr v) x))))) + (gsl-vector-add-constant (gsl-vec-ptr v) x))))) (values v status)))
(defun max-value (v) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (ecase (gsl-vec-element-type v) ('integer (gsl-vector-int-max (gsl-vec-ptr v))) ('single-float (gsl-vector-float-max (gsl-vec-ptr v))) ('double-float - (gsl-vector-max (gsl-vec-ptr v))) - ('complex-single-float - (gsl-vector-complex-float-max (gsl-vec-ptr v))) - ('complex-double-float - (gsl-vector-complex-max (gsl-vec-ptr v))))) + (gsl-vector-max (gsl-vec-ptr v)))))
(defun min-value (v) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (ecase (gsl-vec-element-type v) ('integer (gsl-vector-int-min (gsl-vec-ptr v))) ('single-float (gsl-vector-float-min (gsl-vec-ptr v))) ('double-float - (gsl-vector-min (gsl-vec-ptr v))) - ('complex-single-float - (gsl-vector-complex-float-min (gsl-vec-ptr v))) - ('complex-double-float - (gsl-vector-complex-min (gsl-vec-ptr v))))) + (gsl-vector-min (gsl-vec-ptr v)))))
(defun max-index (v) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (ecase (gsl-vec-element-type v) ('integer (gsl-vector-int-max-index (gsl-vec-ptr v))) ('single-float (gsl-vector-float-max-index (gsl-vec-ptr v))) ('double-float - (gsl-vector-max-index (gsl-vec-ptr v))) - ('complex-single-float - (gsl-vector-complex-float-max-index (gsl-vec-ptr v))) - ('complex-double-float - (gsl-vector-complex-max-index (gsl-vec-ptr v))))) + (gsl-vector-max-index (gsl-vec-ptr v)))))
-(defun max-index (v) - (declare (gsl-vec v)) +(defun min-index (v) + (assert (eq 'gsl (type-of v))) (ecase (gsl-vec-element-type v) ('integer (gsl-vector-int-min-index (gsl-vec-ptr v))) ('single-float (gsl-vector-float-min-index (gsl-vec-ptr v))) ('double-float - (gsl-vector-min-index (gsl-vec-ptr v))) - ('complex-single-float - (gsl-vector-complex-float-min-index (gsl-vec-ptr v))) - ('complex-double-float - (gsl-vector-complex-min-index (gsl-vec-ptr v))))) - + (gsl-vector-min-index (gsl-vec-ptr v)))))
(defun min-max-indicies (v) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (let ((min-ptr (uffi:allocate-foreign-object 'size-t)) (max-ptr (uffi:allocate-foreign-object 'size-t))) (ecase (gsl-vec-element-type v) ('integer - (gsl-vector-int-minmax-index (gsl-vec-ptr v))) + (gsl-vector-int-minmax-index (gsl-vec-ptr v) min-ptr max-ptr)) ('single-float - (gsl-vector-float-minmax-index (gsl-vec-ptr v))) + (gsl-vector-float-minmax-index (gsl-vec-ptr v) min-ptr max-ptr)) ('double-float - (gsl-vector-minmax-index (gsl-vec-ptr v))) - ('complex-single-float - (gsl-vector-complex-float-minmax-index (gsl-vec-ptr v))) - ('complex-double-float - (gsl-vector-complex-minmax-index (gsl-vec-ptr v)))) + (gsl-vector-minmax-index (gsl-vec-ptr v) min-ptr max-ptr))) (prog1 - (list (uffi:deref-pointer 'size-t min-ptr) - (uffi:deref-pointer 'size-t max-ptr)) + (list (uffi:deref-pointer min-ptr 'size-t) + (uffi:deref-pointer max-ptr 'size-t)) (uffi:free-foreign-object min-ptr) (uffi:free-foreign-object max-ptr))))
(defun min-max-values (v) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (destructuring-bind (min-index max-index) (min-max-indicies v) (list (get-element v min-index) @@ -780,7 +767,7 @@
(defun isnull (v) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (1/0->t/nil (ecase (gsl-vec-element-type v) ('integer (gsl-vector-int-isnull (gsl-vec-ptr v)))