From c8f3ba78a8dbc21fcbe2a731adeacfb68e87df2f Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Thu, 1 Nov 2012 22:41:47 +0900 Subject: [PATCH] fixing string-copy! --- lib/scheme/extras.scm | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/lib/scheme/extras.scm b/lib/scheme/extras.scm index e676156d..29a9e4bf 100644 --- a/lib/scheme/extras.scm +++ b/lib/scheme/extras.scm @@ -190,10 +190,11 @@ ;; Never use this! (define (string-copy! to at from . o) - (let ((start (if (pair? o) (car o) 0)) - (end (if (and (pair? o) (pair? (cdr o))) (cadr o) (string-length from)))) - (do ((i at (+ i 1)) (j start (+ i 1))) - ((>= j end)) + (let* ((start (if (pair? o) (car o) 0)) + (end (if (and (pair? o) (pair? (cdr o))) (cadr o) (string-length from))) + (limit (min end (+ start (- (string-length to) at))))) + (do ((i at (+ i 1)) (j start (+ j 1))) + ((>= j limit)) (string-set! to i (string-ref from j))))) (define truncate-quotient quotient)