From 2da5d440a8ab26d71d9fe4173368881357d16376 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 15 Jul 2014 21:26:08 +0900
Subject: [PATCH] more array functions

---
 piclib/picrin/array.scm | 22 ++++++++++++++++++++--
 t/array.scm             | 24 +++++++++++++++++++++---
 2 files changed, 41 insertions(+), 5 deletions(-)

diff --git a/piclib/picrin/array.scm b/piclib/picrin/array.scm
index 04167d6d..deb9cc21 100644
--- a/piclib/picrin/array.scm
+++ b/piclib/picrin/array.scm
@@ -31,7 +31,9 @@
     (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-data! ary (vector-append
+                            (array-data ary)
+                            (make-vector (- size (array-size ary)))))
       (set-array-size! ary size)))
 
   (define (array-ref ary i)
@@ -47,9 +49,25 @@
     (array-set! ary (array-length ary) obj)
     (set-array-tail! ary (translate ary (+ (array-tail ary) 1))))
 
+  (define (array-pop! ary)
+    (set-array-tail! ary (translate ary (- (array-tail ary) 1)))
+    (array-ref ary (array-length ary)))
+
+  (define (array-shift! ary)
+    (set-array-head! ary (translate ary (+ (array-head ary) 1)))
+    (array-ref ary -1))
+
+  (define (array-unshift! ary obj)
+    (array-reserve! ary (+ (array-length ary) 1))
+    (array-set! ary -1 obj)
+    (set-array-head! ary (translate ary (- (array-head ary) 1))))
+
   (export make-array
           array?
           array-length
           array-ref
           array-set!
-          array-push!))
+          array-push!
+          array-pop!
+          array-shift!
+          array-unshift!))
diff --git a/t/array.scm b/t/array.scm
index dc41f462..22593546 100644
--- a/t/array.scm
+++ b/t/array.scm
@@ -15,10 +15,28 @@
 (array-push! ary 3)
 (write ary)
 (newline)
-(write (array-ref ary 0))
+(write (array-pop! ary))
 (newline)
-(write (array-ref ary 1))
+(write (array-pop! ary))
 (newline)
-(write (array-ref ary 2))
+(write (array-pop! ary))
+(newline)
+
+(write ary)
+(newline)
+(array-unshift! ary 1)
+(write ary)
+(newline)
+(array-unshift! ary 2)
+(write ary)
+(newline)
+(array-unshift! ary 3)
+(write ary)
+(newline)
+(write (array-shift! ary))
+(newline)
+(write (array-shift! ary))
+(newline)
+(write (array-shift! ary))
 (newline)