1 files changed, 150 insertions, 0 deletions
diff --git a/chickadee/data/array-list.scm b/chickadee/data/array-list.scm
new file mode 100644
index 0000000..eb3e32a
--- /dev/null
+++ b/chickadee/data/array-list.scm
@@ -0,0 +1,150 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2017 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (chickadee data array-list)
+  #:use-module (chickadee utils)
+  #:use-module (ice-9 format)
+  #:use-module (rnrs base)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (srfi srfi-43)
+  #:export (make-array-list
+            array-list
+            array-list?
+            array-list-empty?
+            array-list-size
+            array-list-ref
+            array-list-set!
+            array-list-push!
+            array-list-pop!
+            array-list-delete!
+            array-list-clear!
+            array-list-for-each
+            array-list-fold))
+
+(define-record-type <array-list>
+  (%make-array-list vector size)
+  array-list?
+  (vector array-list-vector set-array-list-vector!)
+  (size array-list-size set-array-list-size!))
+
+(define (display-array-list array-list port)
+  (display "<array-list" port)
+  (array-list-for-each (lambda (i item)
+                         (display " " port)
+                         (display item port))
+                       array-list)
+  (display ">" port))
+
+(set-record-type-printer! <array-list> display-array-list)
+
+(define* (make-array-list #:optional (initial-capacity 32))
+  (%make-array-list (make-vector initial-capacity) 0))
+
+(define (array-list . items)
+  (let ((l (make-array-list)))
+    (for-each (lambda (item)
+                (array-list-push! l item))
+              items)
+    l))
+
+(define (array-list-capacity array-list)
+  (vector-length (array-list-vector array-list)))
+
+(define (array-list-full? array-list)
+  (= (array-list-size array-list)
+     (array-list-capacity array-list)))
+
+(define (array-list-empty? array-list)
+  (zero? (array-list-size array-list)))
+
+(define (expand-array-list! array-list)
+  (let* ((old-vec (array-list-vector array-list))
+         (old-size (vector-length old-vec))
+         (new-size (+ old-size (div old-size 2)))
+         (new-vec (make-vector new-size)))
+    (vector-copy! new-vec 0 old-vec)
+    (set-array-list-vector! array-list new-vec)))
+
+(define (array-list-ref array-list i)
+  (if (and (>= i 0) (< i (array-list-size array-list)))
+      (vector-ref (array-list-vector array-list) i)
+      (error "array list index out of bounds" i)))
+
+(define (array-list-set! array-list i x)
+  (vector-set! (array-list-vector array-list) i x))
+
+(define (array-list-push! array-list item)
+  (when (array-list-full? array-list)
+    (expand-array-list! array-list))
+  (let ((index (array-list-size array-list)))
+    (set-array-list-size! array-list (1+ index))
+    (array-list-set! array-list index item)))
+
+(define (array-list-pop! array-list)
+  (let* ((index (1- (array-list-size array-list)))
+         (item (array-list-ref array-list index)))
+    ;; Remove element reference so it can be GC'd.
+    (array-list-set! array-list index #f)
+    (set-array-list-size! array-list index)
+    item))
+
+(define* (array-list-delete! array-list item #:key (equal? equal?) fast?)
+  (let* ((v (array-list-vector array-list))
+         (n (array-list-size array-list)))
+    (let loop ((i 0))
+      (when (< i n)
+        (if (equal? item (vector-ref v i))
+            (begin
+              (if fast?
+                  ;; Fast: Swap the last element with the element to be
+                  ;; deleted.  Constant time but does not preserve
+                  ;; order.
+                  (let ((last (- n 1)))
+                    (vector-set! v i (vector-ref v last))
+                    (vector-set! v last #f))
+                  ;; Slow: Shift all elements to the left. Linear time
+                  ;; but preserves order.
+                  (let shift ((j (+ i 1)))
+                    (if (= j n)
+                        (vector-set! v j #f)
+                        (begin
+                          (vector-set! v (- j 1) (vector-ref v j))
+                          (shift (+ j 1))))))
+              (set-array-list-size! array-list (- n 1)))
+            (loop (+ i 1)))))))
+
+(define (array-list-clear! array-list)
+  (let ((vec (array-list-vector array-list)))
+    ;; Remove all element references so they can be GC'd.
+    (for-range ((i (array-list-size array-list)))
+      (vector-set! vec i #f)))
+  (set-array-list-size! array-list 0)
+  *unspecified*)
+
+(define (array-list-for-each proc array-list)
+  (let ((vec (array-list-vector array-list)))
+    (for-range ((i (array-list-size array-list)))
+      (proc i (vector-ref vec i)))))
+
+(define (array-list-fold proc init array-list)
+  (let ((vec (array-list-vector array-list)))
+    (let loop ((i 0)
+               (prev init))
+      (if (< i (array-list-size array-list))
+          (loop (1+ i) (proc i (vector-ref vec i) prev))
+          prev))))