vector-copy and vector-copy! in (scheme base)

goldfish/scheme/base.scm

@@ -22,6 +22,8 @@
   ; Vector
   vector->string
   string->vector
+  vector-copy
+  vector-copy!
   ; Input and Output
   call-with-port port? binary-port? textual-port?
   input-port-open? output-port-open?
@@ -59,6 +61,32 @@
   (let ((stop (or end (length s)))) 
     (copy s (make-vector (- stop start)) start stop)))
 
+(define* (vector-copy v (start 0) (end (vector-length v)))
+  (if (or (> start end) (> end (vector-length v)))
+      (error 'out-of-range "vector-copy")
+      (let ((new-v (make-vector (- end start))))
+        (let loop ((i start) (j 0))
+          (if (>= i end)
+              new-v
+              (begin
+                (vector-set! new-v j (vector-ref v i))
+                (loop (+ i 1) (+ j 1))))))))
+
+(define* (vector-copy! to at from (start 0) (end (vector-length from)))
+  (if (or (< at 0)
+          (> start (vector-length from))
+          (< end 0)
+          (> end (vector-length from))
+          (> start end)
+          (> (+ at (- end start)) (vector-length to)))
+      (error 'out-of-range "vector-copy!")
+      (let loop ((to-i at) (from-i start))
+        (if (>= from-i end)
+            to
+            (begin
+              (vector-set! to to-i (vector-ref from from-i))
+              (loop (+ to-i 1) (+ from-i 1)))))))
+
 (define (string-map p . args) (apply string (apply map p args)))
 
 (define (vector-map p . args) (apply vector (apply map p args)))