From 443bd6e830d078acb8c4266bd52bb8e9de18c8e2 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 15 Jul 2014 20:59:29 +0900
Subject: [PATCH] initial array support

---
 piclib/CMakeLists.txt   |  1 +
 piclib/picrin/array.scm | 55 +++++++++++++++++++++++++++++++++++++++++
 t/array.scm             | 24 ++++++++++++++++++
 3 files changed, 80 insertions(+)
 create mode 100644 piclib/picrin/array.scm
 create mode 100644 t/array.scm

diff --git a/piclib/CMakeLists.txt b/piclib/CMakeLists.txt
index 49f1c4b3..aaf66fdd 100644
--- a/piclib/CMakeLists.txt
+++ b/piclib/CMakeLists.txt
@@ -1,5 +1,6 @@
 list(APPEND PICLIB_SCHEME_LIBS
   ${PROJECT_SOURCE_DIR}/piclib/built-in.scm
+  ${PROJECT_SOURCE_DIR}/piclib/picrin/array.scm
   ${PROJECT_SOURCE_DIR}/piclib/picrin/dictionary.scm
   ${PROJECT_SOURCE_DIR}/piclib/srfi/1.scm
   ${PROJECT_SOURCE_DIR}/piclib/srfi/8.scm
diff --git a/piclib/picrin/array.scm b/piclib/picrin/array.scm
new file mode 100644
index 00000000..04167d6d
--- /dev/null
+++ b/piclib/picrin/array.scm
@@ -0,0 +1,55 @@
+(define-library (picrin array)
+  (import (scheme base))
+
+  (define-record-type array
+    (create-array data size head tail)
+    array?
+    (data array-data set-array-data!)
+    (size array-size set-array-size!)
+    (head array-head set-array-head!)
+    (tail array-tail set-array-tail!))
+
+  (define (translate ary i)
+    (floor-remainder i (array-size ary)))
+
+  (define (make-array)
+    (create-array (vector) 0 0 0))
+
+  (define (array-length ary)
+    (let ((size (- (array-tail ary) (array-head ary))))
+     (translate ary size)))
+
+  (define (array-rotate! ary)
+    (when (< (array-tail ary) (array-head ary))
+      (let ((xs (vector-copy (array-data ary) 0 (array-head ary)))
+            (ys (vector-copy (array-data ary) (array-head ary))))
+        (set-array-data! ary (vector-append ys xs))
+        (set-array-tail! ary (array-length ary))
+        (set-array-head! ary 0))))
+
+  (define (array-reserve! ary size)
+    (set! size (+ size 1))              ; capa == size - 1
+    (when (< (array-size ary) size)
+      (array-rotate! ary)
+      (set-array-data! ary (vector-append (array-data ary) (make-vector (- size (array-size ary)))))
+      (set-array-size! ary size)))
+
+  (define (array-ref ary i)
+    (let ((data (array-data ary)))
+      (vector-ref data (translate ary (+ (array-head ary) i)))))
+
+  (define (array-set! ary i obj)
+    (let ((data (array-data ary)))
+      (vector-set! data (translate ary (+ (array-head ary) i)) obj)))
+
+  (define (array-push! ary obj)
+    (array-reserve! ary (+ (array-length ary) 1))
+    (array-set! ary (array-length ary) obj)
+    (set-array-tail! ary (translate ary (+ (array-tail ary) 1))))
+
+  (export make-array
+          array?
+          array-length
+          array-ref
+          array-set!
+          array-push!))
diff --git a/t/array.scm b/t/array.scm
new file mode 100644
index 00000000..dc41f462
--- /dev/null
+++ b/t/array.scm
@@ -0,0 +1,24 @@
+(import (scheme base)
+        (scheme write)
+        (picrin array))
+
+(define ary (make-array))
+
+(write ary)
+(newline)
+(array-push! ary 1)
+(write ary)
+(newline)
+(array-push! ary 2)
+(write ary)
+(newline)
+(array-push! ary 3)
+(write ary)
+(newline)
+(write (array-ref ary 0))
+(newline)
+(write (array-ref ary 1))
+(newline)
+(write (array-ref ary 2))
+(newline)
+