From 8585f84e1f1f2449581bb577566e8b37b0a195f0 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 23 Feb 2004 20:50:33 +0000
Subject: [PATCH] Rewrite STRING->WIDE-STRING to make it more efficient.

---
 v7/src/runtime/unicode.scm | 32 +++++++++++++++++++-------------
 1 file changed, 19 insertions(+), 13 deletions(-)

diff --git a/v7/src/runtime/unicode.scm b/v7/src/runtime/unicode.scm
index b4e9911f6..e189c2c1c 100644
--- a/v7/src/runtime/unicode.scm
+++ b/v7/src/runtime/unicode.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: unicode.scm,v 1.14 2004/02/16 05:39:15 cph Exp $
+$Id: unicode.scm,v 1.15 2004/02/23 20:50:33 cph Exp $
 
 Copyright 2001,2003,2004 Massachusetts Institute of Technology
 
@@ -670,18 +670,24 @@ USA.
   unspecific)
 
 (define (string->wide-string string #!optional start end)
-  (let ((input
-	 (open-input-string string
-			    (if (default-object? start) #f start)
-			    (if (default-object? end) #f end))))
-    (call-with-wide-output-string
-     (lambda (output)
-       (let loop ()
-	 (let ((char (read-char input)))
-	   (if (not (eof-object? char))
-	       (begin
-		 (write-char char output)
-		 (loop)))))))))
+  (guarantee-string string 'STRING->WIDE-STRING)
+  (let* ((end
+	  (if (or (default-object? end) (not end))
+	      (string-length string)
+	      (guarantee-substring-end-index end (string-length string)
+					     'STRING->WIDE-STRING)))
+	 (start
+	  (if (or (default-object? start) (not start))
+	      0
+	      (guarantee-substring-start-index start end
+					       'STRING->WIDE-STRING)))
+	 (n (fix:- end start))
+	 (v (make-vector n)))
+    (do ((i start (fix:+ i 1))
+	 (j 0 (fix:+ j 1)))
+	((not (fix:< i end)))
+      (vector-set! v j (string-ref string i)))
+    (%make-wide-string v)))
 
 (define (open-wide-input-string string #!optional start end)
   (guarantee-wide-string string 'OPEN-WIDE-INPUT-STRING)
-- 
2.25.1