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

fix bug of `{bytevector, vector}-copy!` with the same src and dst

This commit is contained in:
Sunrim KIM (keen) 2014-07-07 04:16:40 +09:00
parent 10032ea96a
commit 351d7948c0
1 changed files with 27 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
piclib/built-in.scm
View File

@ -777,14 +777,20 @@
(apply vector list))
(define (vector-copy! to at from . opts)
(let ((start (if (pair? opts) (car opts) 0))
(end (if (>= (length opts) 2)
(cadr opts)
(vector-length from))))
(do ((i at (+ i 1))
(j start (+ j 1)))
((= j end))
(vector-set! to i (vector-ref from j)))))
(let* ((start (if (pair? opts) (car opts) 0))
(end (if (>= (length opts) 2)
(cadr opts)
(vector-length from)))
(vs #f))
(if (eq? from to)
(begin
(set! vs (make-vector (- end start)))
(vector-copy! vs 0 from start end)
(vector-copy! to at vs))
(do ((i at (+ i 1))
(j start (+ j 1)))
((= j end))
(vector-set! to i (vector-ref from j))))))
(define (vector-copy v . opts)
(let ((start (if (pair? opts) (car opts) 0))
@ -836,14 +842,20 @@
(bytevector-u8-set! v i (car l))))))
(define (bytevector-copy! to at from . opts)
(let ((start (if (pair? opts) (car opts) 0))
(end (if (>= (length opts) 2)
(let* ((start (if (pair? opts) (car opts) 0))
(end (if (>= (length opts) 2)
(cadr opts)
(bytevector-length from))))
(do ((i at (+ i 1))
(j start (+ j 1)))
((= j end))
(bytevector-u8-set! to i (bytevector-u8-ref from j)))))
(bytevector-length from)))
(vs #f))
(if (eq? from to)
(begin
(set! vs (make-bytevector (- end start)))
(bytevector-copy! vs 0 from start end)
(bytevector-copy! to at vs))
(do ((i at (+ i 1))
(j start (+ j 1)))
((= j end))
(bytevector-u8-set! to i (bytevector-u8-ref from j))))))
(define (bytevector-copy v . opts)
(let ((start (if (pair? opts) (car opts) 0))