+ (funcall function (funcall reader location offset)))
+ finally (return sequence))))))
+
+
+(defun destroy-c-vector (location element-type length)
+ (loop
+ with destroy = (destroy-function element-type)
+ with element-size = (size-of element-type)
+ for i from 0 below length
+ as offset = 0 then (+ offset element-size)
+ do (funcall destroy location offset))
+ (deallocate-memory location))
+
+
+(defmethod alien-type ((type (eql 'vector)) &rest args)
+ (declare (ignore type args))
+ (alien-type 'pointer))
+
+(defmethod size-of ((type (eql 'vector)) &rest args)
+ (declare (ignore type args))
+ (size-of 'pointer))
+
+(defmethod to-alien-form (vector (type (eql 'vector)) &rest args)
+ (declare (ignore type))
+ (destructuring-bind (element-type &optional (length '*)) args
+ (if (eq length '*)
+ `(let* ((vector ,vector)
+ (location (sap+
+ (allocate-memory (+ ,+size-of-int+
+ (* ,(size-of element-type)
+ (length vector))))
+ ,+size-of-int+)))
+ (make-c-vector ',element-type (length vector) vector location)
+ (setf (sap-ref-32 location ,(- +size-of-int+)) (length vector))
+ location)
+ `(make-c-vector ',element-type ,length ,vector))))
+
+(defmethod from-alien-form (c-vector (type (eql 'vector)) &rest args)
+ (declare (ignore type))
+ (destructuring-bind (element-type &optional (length '*)) args
+ (if (eq length '*)
+ (error "Can't use vector of variable size as return type")
+ `(let ((c-vector ,c-vector))
+ (prog1
+ (map-c-vector 'vector #'identity ',element-type ,length c-vector)
+ (destroy-c-vector c-vector ',element-type ,length))))))
+
+(defmethod copy-from-alien-form (c-vector (type (eql 'vector)) &rest args)
+ (declare (ignore type))
+ (destructuring-bind (element-type &optional (length '*)) args
+ (if (eq length '*)
+ (error "Can't use vector of variable size as return type")
+ `(map-c-vector 'vector #'identity ',element-type ',length ,c-vector))))
+
+(defmethod cleanup-form (location (type (eql 'vector)) &rest args)
+ (declare (ignore type))
+ (destructuring-bind (element-type &optional (length '*)) args
+ `(let* ((location ,location)
+ (length ,(if (eq length '*)
+ `(sap-ref-32 location ,(- +size-of-int+))
+ length)))
+ (loop
+ with destroy = (destroy-function ',element-type)
+ for i from 0 below length
+ as offset = 0 then (+ offset ,(size-of element-type))
+ do (funcall destroy location offset))
+ (deallocate-memory ,(if (eq length '*)
+ `(sap+ location ,(- +size-of-int+))
+ 'location)))))
+
+(defmethod writer-function ((type (eql 'vector)) &rest args)
+ (declare (ignore type))
+ (destructuring-bind (element-type &optional (length '*)) args
+ #'(lambda (vector location &optional (offset 0))
+ (setf
+ (sap-ref-sap location offset)
+ (make-c-vector element-type length vector)))))
+
+(defmethod reader-function ((type (eql 'vector)) &rest args)
+ (declare (ignore type))
+ (destructuring-bind (element-type &optional (length '*)) args
+ (if (eq length '*)
+ (error "Can't create reader function for vector of variable size")
+ #'(lambda (location &optional (offset 0))
+ (unless (null-pointer-p (sap-ref-sap location offset))
+ (map-c-vector 'vector #'identity (sap-ref-sap location offset)
+ element-type length))))))
+
+(defmethod destroy-function ((type (eql 'vector)) &rest args)
+ (declare (ignore type))
+ (destructuring-bind (element-type &optional (length '*)) args
+ (if (eq length '*)
+ (error "Can't create destroy function for vector of variable size")
+ #'(lambda (location &optional (offset 0))
+ (unless (null-pointer-p (sap-ref-sap location offset))
+ (destroy-c-vector
+ (sap-ref-sap location offset) element-type length)
+ (setf (sap-ref-sap location offset) (make-pointer 0)))))))