conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

more array functions

This commit is contained in:
Yuichi Nishiwaki 2014-07-15 21:26:08 +09:00
parent 443bd6e830
commit 2da5d440a8
2 changed files with 41 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
piclib/picrin/array.scm
View File

@ -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!))

24
t/array.scm
View File

@ -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)