+ (vector
+ (let ((vector (make-array length :element-type element-type)))
+ (cond
+ #+(or cmu sbcl)
+ ((and
+ (typep vector 'simple-unboxed-array)
+ (or (eq function 'identity) (eq function #'identity)))
+ (with-pinned-objects (vector)
+ (copy-memory location (* length element-size) (vector-sap vector))))
+ (t
+ (loop
+ for i below length
+ for offset by element-size
+ do (setf
+ (aref vector i)
+ (funcall function (funcall reader location offset))))))
+ vector))