Advertisement
Guest User

Untitled

a guest
Jul 18th, 2019
70
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.06 KB | None | 0 0
  1. (defun fill-array-with-seq (array initial-contents)
  2. (declare (array array)
  3. (sequence initial-contents)
  4. (optimize (safety 0)))
  5. (labels ((iterate-over-contents (array contents dims written)
  6. (declare (fixnum written)
  7. (array array)
  8. (optimize (safety 0)))
  9. (when (/= (length contents) (first dims))
  10. (error "In MAKE-ARRAY: the elements in :INITIAL-CONTENTS do not match the array dimensions"))
  11. (if (= (length dims) 1)
  12. (do* ((it (make-seq-iterator contents) (seq-iterator-next contents it)))
  13. ((null it))
  14. (sys:row-major-aset array written (seq-iterator-ref contents it))
  15. (incf written))
  16. (do* ((it (make-seq-iterator contents) (seq-iterator-next contents it)))
  17. ((null it))
  18. (setf written (iterate-over-contents array
  19. (seq-iterator-ref contents it)
  20. (rest dims)
  21. written))))
  22. written))
  23. (let ((dims (array-dimensions array)))
  24. (if dims
  25. (iterate-over-contents array initial-contents dims 0)
  26. (setf (row-major-aref array 0) initial-contents))))
  27. array)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement