Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (defun fill-array-with-seq (array initial-contents)
- (declare (array array)
- (sequence initial-contents)
- (optimize (safety 0)))
- (labels ((iterate-over-contents (array contents dims written)
- (declare (fixnum written)
- (array array)
- (optimize (safety 0)))
- (when (/= (length contents) (first dims))
- (error "In MAKE-ARRAY: the elements in :INITIAL-CONTENTS do not match the array dimensions"))
- (if (= (length dims) 1)
- (do* ((it (make-seq-iterator contents) (seq-iterator-next contents it)))
- ((null it))
- (sys:row-major-aset array written (seq-iterator-ref contents it))
- (incf written))
- (do* ((it (make-seq-iterator contents) (seq-iterator-next contents it)))
- ((null it))
- (setf written (iterate-over-contents array
- (seq-iterator-ref contents it)
- (rest dims)
- written))))
- written))
- (let ((dims (array-dimensions array)))
- (if dims
- (iterate-over-contents array initial-contents dims 0)
- (setf (row-major-aref array 0) initial-contents))))
- array)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement