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