+ (coerce
+ (loop
+ as offset = 0 then (+ offset size-of-element)
+ until (null-pointer-p (sap-ref-sap location offset))
+ collect (funcall function (funcall reader location offset)))
+ seqtype)))))
+
+
+(defun destroy-0-vector (location element-type)
+ (loop
+ with destroy = (destroy-function element-type)
+ with element-size = (size-of element-type)
+ as offset = 0 then (+ offset element-size)
+ until (null-pointer-p (sap-ref-sap location offset))
+ do (funcall destroy location offset))
+ (deallocate-memory location))
+
+(deftype null-terminated-vector (element-type) `(vector ,element-type))
+
+(define-type-method alien-type ((type null-terminated-vector))
+ (declare (ignore type))
+ (alien-type 'pointer))
+
+(define-type-method size-of ((type null-terminated-vector))
+ (declare (ignore type))
+ (size-of 'pointer))
+
+(define-type-method to-alien-form ((type null-terminated-vector) vector)
+ (destructuring-bind (element-type)
+ (rest (type-expand-to 'null-terminated-vector type))
+ `(make-0-vector ',element-type ,vector)))
+
+(define-type-method from-alien-form ((type null-terminated-vector) c-vector)
+ (destructuring-bind (element-type)
+ (rest (type-expand-to 'null-terminated-vector type))
+ `(let ((c-vector ,c-vector))
+ (prog1
+ (map-0-vector 'vector #'identity c-vector ',element-type)
+ (destroy-0-vector c-vector ',element-type)))))
+
+(define-type-method copy-from-alien-form ((type null-terminated-vector) c-vector)
+ (destructuring-bind (element-type)
+ (rest (type-expand-to 'null-terminated-vector type))
+ `(map-0-vector 'vector #'identity ,c-vector ',element-type)))
+
+(define-type-method cleanup-form ((type null-terminated-vector) location)
+ (destructuring-bind (element-type)
+ (rest (type-expand-to 'null-terminated-vector type))
+ `(destroy-0-vector ,location ',element-type)))
+
+(define-type-method writer-function ((type null-terminated-vector))
+ (destructuring-bind (element-type)
+ (rest (type-expand-to 'null-terminated-vector type))
+ (unless (eq (alien-type element-type) (alien-type 'pointer))
+ (error "Elements in null-terminated vectors need to be of pointer types"))
+ #'(lambda (vector location &optional (offset 0))
+ (setf
+ (sap-ref-sap location offset)
+ (make-0-vector element-type vector)))))
+
+(define-type-method reader-function ((type null-terminated-vector))
+ (destructuring-bind (element-type)
+ (rest (type-expand-to 'null-terminated-vector type))
+ (unless (eq (alien-type element-type) (alien-type 'pointer))
+ (error "Elements in null-terminated vectors need to be of pointer types"))
+ #'(lambda (location &optional (offset 0) weak-p)
+ (declare (ignore weak-p))
+ (unless (null-pointer-p (sap-ref-sap location offset))
+ (map-0-vector 'vector #'identity (sap-ref-sap location offset)
+ element-type)))))
+
+(define-type-method destroy-function ((type null-terminated-vector))
+ (destructuring-bind (element-type)
+ (rest (type-expand-to 'null-terminated-vector type))
+ (unless (eq (alien-type element-type) (alien-type 'pointer))
+ (error "Elements in null-terminated vectors need to be of pointer types"))
+ #'(lambda (location &optional (offset 0))
+ (unless (null-pointer-p (sap-ref-sap location offset))
+ (destroy-0-vector
+ (sap-ref-sap location offset) element-type)
+ (setf (sap-ref-sap location offset) (make-pointer 0))))))
+
+(define-type-method unbound-value ((type null-terminated-vector))
+ (declare (ignore type))
+ nil)
+
+
+
+
+;;; Counted vector
+
+(defun make-counted-vector (type content)
+ (let* ((size-of-type (size-of type))
+ (length (length content))
+ (location
+ (allocate-memory (+ +size-of-int+ (* size-of-type length)))))
+ (setf (sap-ref-32 location 0) length)
+ (make-c-vector type length content (sap+ location +size-of-int+))))
+
+(defun map-counted-vector (seqtype function location element-type)
+ (let ((length (sap-ref-32 location 0)))
+ (map-c-vector
+ seqtype function (sap+ location +size-of-int+)
+ element-type length)))
+
+(defun destroy-counted-vector (location element-type)
+ (loop
+ with destroy = (destroy-function element-type)
+ with element-size = (size-of element-type)
+ for i from 0 below (sap-ref-32 location 0)
+ as offset = +size-of-int+ then (+ offset element-size)
+ do (funcall destroy location offset))
+ (deallocate-memory location))
+
+
+(deftype counted-vector (element-type) `(vector ,element-type))
+
+(define-type-method alien-type ((type counted-vector))
+ (declare (ignore type))
+ (alien-type 'pointer))
+
+(define-type-method size-of ((type counted-vector))
+ (declare (ignore type))
+ (size-of 'pointer))
+
+(define-type-method to-alien-form ((type counted-vector) vector)
+ (destructuring-bind (element-type)
+ (rest (type-expand-to 'counted-vector type))
+ `(make-counted-vector ',element-type ,vector)))
+
+(define-type-method from-alien-form ((type counted-vector) c-vector)
+ (destructuring-bind (element-type)
+ (rest (type-expand-to 'counted-vector type))
+ `(let ((c-vector ,c-vector))
+ (prog1
+ (map-counted-vector 'vector #'identity c-vector ',element-type)
+ (destroy-counted-vector c-vector ',element-type)))))
+
+(define-type-method copy-from-alien-form ((type counted-vector) c-vector)
+ (destructuring-bind (element-type)
+ (rest (type-expand-to 'counted-vector type))
+ `(map-counted-vector 'vector #'identity ,c-vector ',element-type)))
+
+(define-type-method copy-from-alien-function ((type counted-vector))
+ (destructuring-bind (element-type)
+ (rest (type-expand-to 'counted-vector type))
+ #'(lambda (c-vector)
+ (map-counted-vector 'vector #'identity c-vector element-type))))
+
+(define-type-method cleanup-form ((type counted-vector) location)
+ (destructuring-bind (element-type)
+ (rest (type-expand-to 'counted-vector type))
+ `(destroy-counted-vector ,location ',element-type)))
+
+(define-type-method writer-function ((type counted-vector))
+ (destructuring-bind (element-type)
+ (rest (type-expand-to 'counted-vector type))
+ #'(lambda (vector location &optional (offset 0))
+ (setf
+ (sap-ref-sap location offset)
+ (make-counted-vector element-type vector)))))
+
+(define-type-method reader-function ((type counted-vector))
+ (destructuring-bind (element-type)
+ (rest (type-expand-to 'counted-vector type))
+ #'(lambda (location &optional (offset 0) weak-p)
+ (declare (ignore weak-p))
+ (unless (null-pointer-p (sap-ref-sap location offset))
+ (map-counted-vector 'vector #'identity
+ (sap-ref-sap location offset) element-type)))))
+
+(define-type-method destroy-function ((type counted-vector))
+ (destructuring-bind (element-type)
+ (rest (type-expand-to 'counted-vector type))
+ #'(lambda (location &optional (offset 0))
+ (unless (null-pointer-p (sap-ref-sap location offset))
+ (destroy-counted-vector
+ (sap-ref-sap location offset) element-type)
+ (setf (sap-ref-sap location offset) (make-pointer 0))))))