Merge branch 'array'

docs/libs.rst

@@ -137,6 +137,70 @@ This expression is equivalent to ``(filter even? (iota 10))`` but it is more pro
   Returns ``()`` whatever value is given. The identity element of list composition. This operator corresponds to Haskell's fail method of Monad class.
 
 
+(picrin array)
+--------------
+
+Resizable random-access list.
+
+Technically, picrin's array is implemented as a ring-buffer, effective double-ended queue data structure (deque) that can operate pushing and poping from both of front and back in constant time. In addition to the deque interface, array provides standard sequence interface similar to functions specified by R7RS.
+
+- **(make-array [capacity])**
+
+  Returns a newly allocated array object. If capacity is given, internal data chunk of the array object will be initialized by capacity size.
+
+- **(array . objs)**
+
+  Returns an array initialized with objs.
+
+- **(array? . obj)**
+
+  Returns #t if obj is an array.
+
+- **(array-length ary)**
+
+  Returns the length of ary.
+
+- **(array-ref ary i)**
+
+  Like ``list-ref``, return the object pointed by the index i.
+
+- **(array-set! ary i obj)**
+
+  Like ``list-set!``, substitutes the object pointed by the index i with given obj.
+
+- **(array-push! ary obj)**
+
+  Adds obj to the end of ary.
+
+- **(array-pop! ary)**
+
+  Removes the last element of ary, and returns it.
+
+- **(array-unshift! ary obj)**
+
+  Adds obj to the front of ary.
+
+- **(array-shift! ary)**
+
+  Removes the first element of ary, and returns it.
+
+- **(array-map proc ary)**
+
+  Performs mapping operation on ary.
+
+- **(array-for-each proc ary)**
+
+  Performs mapping operation on ary, but discards the result.
+
+- **(array->list ary)**
+
+  Converts ary into list.
+
+- **(list->array list)**
+
+  Converts list into array.
+
+
 (picrin dictionary)
 -------------------
 

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

piclib/picrin/array.scm

@@ -0,0 +1,103 @@
+(define-library (picrin array)
+  (import (scheme base))
+
+  (define-record-type array-type
+    (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 (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 (make-array . rest)
+    (if (null? rest)
+        (make-array 0)
+        (let ((capacity (car rest))
+              (ary (create-array (vector) 0 0 0)))
+          (array-reserve! ary capacity)
+          ary)))
+
+  (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))))
+
+  (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))))
+
+  (define (array->list ary)
+    (do ((i 0 (+ i 1))
+         (x '() (cons (array-ref ary i) x)))
+        ((= i (array-length ary))
+         (reverse x))))
+
+  (define (list->array list)
+    (let ((ary (make-array)))
+      (for-each (lambda (x) (array-push! ary x)) list)
+      ary))
+
+  (define (array . objs)
+    (list->array objs))
+
+  (define (array-map proc ary)
+    (list->array (map proc (array->list ary))))
+
+  (define (array-for-each proc ary)
+    (for-each proc (array->list ary)))
+
+  (export make-array
+          array
+          array?
+          array-length
+          array-ref
+          array-set!
+          array-push!
+          array-pop!
+          array-shift!
+          array-unshift!
+          array-map
+          array-for-each
+          array->list
+          list->array))

t/array.scm

@@ -0,0 +1,42 @@
+(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-pop! ary))
+(newline)
+(write (array-pop! ary))
+(newline)
+(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)
+