From 7851cd76985296179cf1aabdb4e6d19234aaa316 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 22 Apr 2017 18:17:37 -0700
Subject: [PATCH] Convert list->string, vector->string to use string-builder.

---
 src/runtime/ustring.scm | 59 +++++++++++++++++------------------------
 1 file changed, 24 insertions(+), 35 deletions(-)

diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index 61f48ba77..e9f26c0db 100644
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -1528,18 +1528,12 @@ USA.
 ;;;; Sequence converters
 
 (define (list->string chars)
-  (let ((string
-	 (immutable-ustring-allocate
-	  (length chars)
-	  (fold-left (lambda (max-cp char)
-		       (fix:max max-cp (char->integer char)))
-		     0
-		     chars))))
-    (do ((chars chars (cdr chars))
-	 (i 0 (fix:+ i 1)))
-	((not (pair? chars)))
-      (ustring-set! string i (car chars)))
-    string))
+  (let ((builder (string-builder)))
+    (for-each (lambda (char)
+		(guarantee bitless-char? char 'list->string)
+		(builder char))
+	      chars)
+    (builder)))
 
 (define (string->list string #!optional start end)
   (let* ((end (fix:end-index end (string-length string) 'string->list))
@@ -1560,15 +1554,13 @@ USA.
 (define (vector->string vector #!optional start end)
   (let* ((end (fix:end-index end (vector-length vector) 'vector->string))
 	 (start (fix:start-index start end 'vector->string))
-	 (to
-	  (if (do ((i start (fix:+ i 1))
-		   (8-bit? #t (and 8-bit? (char-8-bit? (vector-ref vector i)))))
-		  ((not (fix:< i end)) 8-bit?))
-	      (legacy-string-allocate (fix:- end start))
-	      (mutable-ustring-allocate (fix:- end start)))))
-    (copy-loop ustring-set! to 0
-	       vector-ref vector start end)
-    to))
+	 (builder (string-builder)))
+    (do ((i start (fix:+ i 1)))
+	((not (fix:< i end)))
+      (let ((char (vector-ref vector i)))
+	(guarantee bitless-char? char 'vector->string)
+	(builder char)))
+    (builder)))
 
 (define (string->vector string #!optional start end)
   (let* ((end (fix:end-index end (string-length string) 'string->vector))
@@ -1576,11 +1568,13 @@ USA.
     (translate-slice string start end
       (lambda (string start end)
 	(let ((to (make-vector (fix:- end start))))
-	  (copy-loop vector-set! to 0
-		     ustring-ref string start end)
+	  (do ((i start (fix:+ i 1))
+	       (j 0 (fix:+ j 1)))
+	      ((not (fix:< i end)))
+	    (vector-set! to j (ustring-ref string i)))
 	  to)))))
-
-;;;; Append and general constructor
+
+;;;; Append
 
 (define (string-append . strings)
   (string-append* strings))
@@ -1603,11 +1597,12 @@ USA.
 		    (builder
 		     (cond ((bitless-char? object) object)
 			   ((string? object) object)
+			   ;; Needed during boot load:
 			   ((symbol? object) (symbol->string object))
-			   ((pathname? object) (->namestring object))
-			   ((number? object) (number->string object))
-			   ((uri? object) (uri->string object))
-			   (else (error "Unknown string component:" object))))))
+			   (else
+			    (call-with-output-string
+			      (lambda (port)
+				(display object port))))))))
 	      objects)
     (builder)))
 
@@ -1899,12 +1894,6 @@ USA.
       string
       (string->utf8 string)))
 
-(define-integrable (copy-loop to-set! to at from-ref from start end)
-  (do ((i start (fix:+ i 1))
-       (j at (fix:+ j 1)))
-      ((not (fix:< i end)))
-    (to-set! to j (from-ref from i))))
-
 (define-integrable (every-loop proc ref string start end)
   (let loop ((i start))
     (if (fix:< i end)
-- 
2.25.1