From 1ba4aeecafc303775bf1bd4908668f2ef73d5b1b Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Sun, 14 Oct 2012 23:07:07 +0900
Subject: [PATCH] More optional start/end parameters.

---
 lib/init-7.scm        | 31 ++++++++++++++++++++++---------
 lib/scheme/extras.scm | 14 ++++----------
 2 files changed, 26 insertions(+), 19 deletions(-)

diff --git a/lib/init-7.scm b/lib/init-7.scm
index 8032c527..87e6a474 100644
--- a/lib/init-7.scm
+++ b/lib/init-7.scm
@@ -406,9 +406,11 @@
    (else
     (string->list (apply substring str o)))))
 
-(define (string-fill! str ch)
-  (let lp ((i (- (string-length str) 1)))
-    (if (>= i 0) (begin (string-set! str i ch) (lp (- i 1))))))
+(define (string-fill! str ch . o)
+  (let ((start (if (pair? o) (car o) 0))
+        (end (if (and (pair? o) (pair? (cdr o))) (cadr o) (string-length str))))
+    (let lp ((i (- end 1)))
+      (if (>= i start) (begin (string-set! str i ch) (lp (- i 1)))))))
 
 (define (string . args) (list->string args))
 (define (string-append . args) (string-concatenate args))
@@ -453,6 +455,13 @@
 
 ;; vector utils
 
+(define (vector-copy vec . o)
+  (let* ((start (if (pair? o) (car o) 0))
+         (end (if (and (pair? o) (pair? (cdr o))) (cadr o) (vector-length vec)))
+         (res (make-vector (- end start))))
+    (do ((i start (+ i 1))) ((>= i end) res)
+      (vector-set! res i (vector-ref vec i)))))
+
 (define (list->vector ls)
   (let ((vec (make-vector (length ls) #f)))
     (let lp ((ls ls) (i 0))
@@ -462,13 +471,17 @@
             (lp (cdr ls) (+ i 1)))))
     vec))
 
-(define (vector->list vec)
-  (let lp ((i (- (vector-length vec) 1)) (res '()))
-    (if (< i 0) res (lp (- i 1) (cons (vector-ref vec i) res)))))
+(define (vector->list vec . o)
+  (let ((start (if (pair? o) (car o) 0))
+        (end (if (and (pair? o) (pair? (cdr o))) (cadr o) (vector-length vec))))
+    (let lp ((i (- end 1)) (res '()))
+      (if (< i start) res (lp (- i 1) (cons (vector-ref vec i) res))))))
 
-(define (vector-fill! str ch)
-  (let lp ((i (- (vector-length str) 1)))
-    (if (>= i 0) (begin (vector-set! str i ch) (lp (- i 1))))))
+(define (vector-fill! vec ch . o)
+  (let ((start (if (pair? o) (car o) 0))
+        (end (if (and (pair? o) (pair? (cdr o))) (cadr o) (vector-length vec))))
+    (let lp ((i (- end 1)))
+      (if (>= i start) (begin (vector-set! vec i ch) (lp (- i 1)))))))
 
 (define (vector . args) (list->vector args))
 
diff --git a/lib/scheme/extras.scm b/lib/scheme/extras.scm
index a7caa833..eef89c9b 100644
--- a/lib/scheme/extras.scm
+++ b/lib/scheme/extras.scm
@@ -135,12 +135,6 @@
                  (lp (+ i 1))))))
       (apply for-each proc (map vector->list (cons vec lov)))))
 
-(define (vector-copy vec)
-  (let* ((len (vector-length vec))
-         (res (make-vector len)))
-    (do ((i 0 (+ i 1))) ((>= i len) res)
-      (vector-set! res i (vector-ref vec i)))))
-
 (define (vector-copy! to at from . o)
   (let ((start (if (pair? o) (car o) 0))
         (end (if (and (pair? o) (pair? (cdr o))) (cadr o) (vector-length from))))
@@ -148,11 +142,11 @@
         ((>= j end))
       (vector-set! to i (vector-ref from j)))))
 
-(define (vector->string vec)
-  (list->string (vector->list vec)))
+(define (vector->string vec . o)
+  (list->string (apply vector->list vec o)))
 
-(define (string->vector vec)
-  (list->vector (string->list vec)))
+(define (string->vector vec . o)
+  (list->vector (apply string->list vec o)))
 
 (define (bytevector-copy! to at from . o)
   (let ((start (if (pair? o) (car o) 0))