growable-vector.lisp 4 KB
Newer Older
Andrew Kravchuk's avatar
Andrew Kravchuk committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
(in-package :d2clone-kit)


(defstruct (growable-vector
            (:constructor %make-growable-vector)
            (:conc-name %growable-vector-)
            (:copier nil)
            (:predicate nil))
  "A simple vector of dynamic size."
  (vector nil :type simple-vector)
  (size nil :type array-length)
  (initial-element nil))

(defconstant +array-growth-factor+ (* 0.5d0 (1+ (sqrt 5d0))))

(declaim (inline make-growable-vector))
(defun make-growable-vector (&key (initial-element nil) (initial-allocated-size 1))
Andrew Kravchuk's avatar
Andrew Kravchuk committed
18 19
  "Creates new growable vector with initial allocated size INITIAL-ALLOCATED-SIZE
(1 by default) and initial element INITIAL-ELEMENT (NIL by default)."
Andrew Kravchuk's avatar
Andrew Kravchuk committed
20 21 22 23 24 25 26 27 28
  (%make-growable-vector
   :vector (make-array initial-allocated-size :initial-element initial-element)
   :size 0
   :initial-element initial-element))

(declaim
 (inline growable-vector-ref)
 (ftype (function (growable-vector array-index) t) growable-vector-ref))
(defun growable-vector-ref (growable-vector index)
Andrew Kravchuk's avatar
Andrew Kravchuk committed
29
  "Access GROWABLE-VECTOR by INDEX."
Andrew Kravchuk's avatar
Andrew Kravchuk committed
30 31 32 33 34 35
  (aref (%growable-vector-vector growable-vector) index))

(declaim
 (inline growable-vector-grow)
 (ftype (function (growable-vector array-length)) growable-vector-grow))
(defun growable-vector-grow (growable-vector new-allocated-size)
Andrew Kravchuk's avatar
Andrew Kravchuk committed
36
  "Adjusts GROWABLE-VECTOR to have allocated size of NEW-ALLOCATED-SIZE."
Andrew Kravchuk's avatar
Andrew Kravchuk committed
37 38 39 40 41 42 43 44 45 46 47 48
  (let ((vector (%growable-vector-vector growable-vector)))
    (when (> new-allocated-size (length vector))
      (setf (%growable-vector-vector growable-vector)
            (adjust-array
             vector
             new-allocated-size
             :initial-element (%growable-vector-initial-element growable-vector))))))

(declaim
 (inline (setf %growable-vector-ref))
 (ftype (function (t growable-vector array-index) t) (setf %growable-vector-ref)))
(defun (setf %growable-vector-ref) (value growable-vector index)
Andrew Kravchuk's avatar
Andrew Kravchuk committed
49
  "Access GROWABLE-VECTOR by INDEX with no bounds checking whatsoever."
Andrew Kravchuk's avatar
Andrew Kravchuk committed
50 51 52 53 54 55 56 57 58
  (setf (%growable-vector-size growable-vector)
        (max (%growable-vector-size growable-vector) (1+ index))
        (aref (%growable-vector-vector growable-vector) index)
        value))

(declaim
 (inline (setf growable-vector-ref))
 (ftype (function (t growable-vector array-index) t) (setf growable-vector-ref)))
(defun (setf growable-vector-ref) (value growable-vector index)
Andrew Kravchuk's avatar
Andrew Kravchuk committed
59 60
  "Access GROWABLE-VECTOR by INDEX, growing if necessary (when index is
greater than current allocated size)."
Andrew Kravchuk's avatar
Andrew Kravchuk committed
61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
  (let* ((vector (%growable-vector-vector growable-vector))
         (allocated-size (length vector)))
    (when (>= index allocated-size)
      (growable-vector-grow
       growable-vector
       (the array-index (round (* index +array-growth-factor+)))))
    (setf (%growable-vector-ref growable-vector index) value)))

;; (declaim
;;  (inline growable-vector-append)
;;  (ftype (function (growable-vector t)) growable-vector-append))
;; (defun growable-vector-append (growable-vector value)
;;   (setf (growable-vector-ref growable-vector (1+ (growable-vector-size growable-vector)))
;;         value))

(declaim
 (inline growable-vector-length)
 (ftype (function (growable-vector) array-length) growable-vector-length))
(defun growable-vector-length (growable-vector)
Andrew Kravchuk's avatar
Andrew Kravchuk committed
80
  "Returns GROWABLE-VECTOR length (i.e. current actual element count)."
Andrew Kravchuk's avatar
Andrew Kravchuk committed
81 82 83 84 85 86
  (%growable-vector-size growable-vector))

(declaim
 (inline growable-vector-clear)
 (ftype (function (growable-vector)) growable-vector-clear))
(defun growable-vector-clear (growable-vector)
Andrew Kravchuk's avatar
Andrew Kravchuk committed
87
  "Removes all elements from GROWABLE-VECTOR."
Andrew Kravchuk's avatar
Andrew Kravchuk committed
88 89 90 91 92 93 94
  (setf (%growable-vector-size growable-vector) 0))

(declaim
 (inline growable-vector-freeze)
 (ftype (function (growable-vector &key (:element-type symbol)) simple-array)
        growable-vector-freeze))
(defun growable-vector-freeze (growable-vector &key (element-type 't))
Andrew Kravchuk's avatar
Andrew Kravchuk committed
95
  "Creates SIMPLE-ARRAY of ELEMENT-TYPE holding the same elements that GROWABLE-VECTOR holds."
Andrew Kravchuk's avatar
Andrew Kravchuk committed
96 97 98 99 100 101
  (let* ((size (%growable-vector-size growable-vector))
         (result (make-array size :element-type element-type)))
    (replace
     result
     (%growable-vector-vector growable-vector))
    result))