Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-23 20:15:05 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Added (vector-copy!)

Browse source
This commit is contained in:
Justin Ethier 2015-06-04 21:35:14 -04:00
parent 969acc2b62
commit 7e21dd7015
2 changed files with 19 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
scheme/base.sld
View file

@ -42,7 +42,7 @@
vector
vector-append
vector-copy
;vector-copy!
vector-copy!
vector-fill!
vector->list
vector->string
@ -201,18 +201,18 @@
(vector-set! new-vec i (vector-ref vec i))
(loop (+ i 1) new-vec))))))
(loop start (make-vector (- end start) #f))))
; TODO:
; (define (vector-copy! vec to at from . opts)
; (letrec ((len (vector-length vec))
; (start (if (> (length opts) 0) (car opts) 0))
; (end (if (> (length opts) 1) (cadr opts) len))
; (loop (lambda (i)
; (cond
; ((= i end) vec)
; (else
; (vector-set! vec i fill)
; (loop (+ i 1)))))))
; (loop start '())))
;; TODO: does not quite meet r7rs spec, should check if vectors overlap
(define (vector-copy! to at from . opts)
(letrec ((len (vector-length from))
(start (if (> (length opts) 0) (car opts) 0))
(end (if (> (length opts) 1) (cadr opts) len))
(loop (lambda (i-at i-from)
(cond
((= i-from end) to)
(else
(vector-set! to i-at (vector-ref from i-from))
(loop (+ i-at 1) (+ i-from 1)))))))
(loop at start)))
;; TODO: this len/start/end/loop pattern is common, could use a macro for it
(define (vector-fill! vec fill . opts)
(letrec ((len (vector-length vec))
@ -224,7 +224,7 @@
(else
(vector-set! vec i fill)
(loop (+ i 1)))))))
(loop start '())))
(loop start)))
(define (boolean=? b1 b2 . bs)
(Cyc-obj=? boolean? b1 (cons b2 bs)))

5
test.scm
View file

@ -15,3 +15,8 @@
(write (equal? #(1 1 1) (make-vector 3 1)))
(write '#(1))
(write '#())
(define a (vector 1 2 3 4 5))
(define b (vector 10 20 30 40 50))
(vector-copy! b 1 a 0 2)
(write (equal? b #(10 1 2 40 50)))