Use string-builder instead of call-with-output-string.

diff --git a/src/runtime/parse.scm b/src/runtime/parse.scm
index a8e95fced73724371b061433b2bedafdbdb3b2ef..40d1148c4fe0921576fce7cf2552c850eb56cd41 100644 (file)
--- a/src/runtime/parse.scm
+++ b/src/runtime/parse.scm
@@ -625,79 +625,79 @@ USA.
   (string->symbol (parse-delimited-string db #\| #f)))
 \f
 (define (parse-delimited-string db delimiter allow-newline-escape?)
-  (call-with-output-string
-    (lambda (port*)
-
-      (define (loop)
-       (dispatch (%read-char/no-eof db)))
-
-      (define (dispatch char)
-       (cond ((char=? delimiter char) unspecific)
-             ((char=? #\\ char) (parse-quoted))
-             (else (emit char))))
-
-      (define (parse-quoted)
-       (let ((char (%read-char/no-eof db)))
-         (cond ((char=? char #\a) (emit #\bel))
-               ((char=? char #\b) (emit #\bs))
-               ((char=? char #\n) (emit #\newline))
-               ((char=? char #\r) (emit #\return))
-               ((char=? char #\t) (emit #\tab))
-               ((char=? char #\x) (emit (parse-hex-escape 0 '())))
-               ((and allow-newline-escape?
-                     (or (char=? char #\newline)
-                         (char=? char #\space)
-                         (char=? char #\tab)))
-                (if (not (char=? char #\newline))
-                    (let ((char (skip-space)))
-                      (if (not (char=? char #\newline))
-                          (error:illegal-char char))))
-                (dispatch (skip-space)))
-               ;; MIT/GNU extensions:
-               ((char=? char #\f) (emit #\page))
-               ((char=? char #\v) (emit #\vt))
-               ((char->digit char 3)
-                => (lambda (d) (emit (parse-octal-escape char d))))
-               (else (emit char)))))
-
-      (define (emit char)
-       (write-char char port*)
-       (loop))
-
-      (define (skip-space)
-       (let ((char (%read-char/no-eof db)))
-         (if (or (char=? char #\space)
-                 (char=? char #\tab))
-             (skip-space)
-             char)))
-
-      (define (parse-hex-escape sv chars)
-       (let* ((char (%read-char/no-eof db))
-              (chars (cons char chars)))
-         (if (char=? #\; char)
-             (begin
-               (if (not (unicode-scalar-value? sv))
-                   (ill-formed-hex chars))
-               (integer->char sv))
-             (let ((digit (char->digit char 16)))
-               (if (not digit)
-                   (ill-formed-hex chars))
-               (parse-hex-escape (+ (* sv #x10) digit) chars)))))
-
-      (define (ill-formed-hex chars)
-       (error:illegal-string-escape
-        (list->string (cons* #\\ #\x (reverse chars)))))
-
-      (define (parse-octal-escape c1 d1)
-       (let* ((c2 (%read-char/no-eof db))
-              (d2 (char->digit c2 8))
-              (c3 (%read-char/no-eof db))
-              (d3 (char->digit c3 8)))
-         (if (not (and d2 d3))
-             (error:illegal-string-escape (list->string (list #\\ c1 c2 c3))))
-         (integer->char (fix:+ (fix:lsh (fix:+ (fix:lsh d1 3) d2) 3) d3))))
-
-      (loop))))
+  (let ((builder (string-builder)))
+
+    (define (loop)
+      (dispatch (%read-char/no-eof db)))
+
+    (define (dispatch char)
+      (cond ((char=? delimiter char) unspecific)
+           ((char=? #\\ char) (parse-quoted))
+           (else (emit char))))
+
+    (define (parse-quoted)
+      (let ((char (%read-char/no-eof db)))
+       (cond ((char=? char #\a) (emit #\bel))
+             ((char=? char #\b) (emit #\bs))
+             ((char=? char #\n) (emit #\newline))
+             ((char=? char #\r) (emit #\return))
+             ((char=? char #\t) (emit #\tab))
+             ((char=? char #\x) (emit (parse-hex-escape 0 '())))
+             ((and allow-newline-escape?
+                   (or (char=? char #\newline)
+                       (char=? char #\space)
+                       (char=? char #\tab)))
+              (if (not (char=? char #\newline))
+                  (let ((char (skip-space)))
+                    (if (not (char=? char #\newline))
+                        (error:illegal-char char))))
+              (dispatch (skip-space)))
+             ;; MIT/GNU extensions:
+             ((char=? char #\f) (emit #\page))
+             ((char=? char #\v) (emit #\vt))
+             ((char->digit char 3)
+              => (lambda (d) (emit (parse-octal-escape char d))))
+             (else (emit char)))))
+
+    (define (emit char)
+      (builder char)
+      (loop))
+
+    (define (skip-space)
+      (let ((char (%read-char/no-eof db)))
+       (if (or (char=? char #\space)
+               (char=? char #\tab))
+           (skip-space)
+           char)))
+
+    (define (parse-hex-escape sv chars)
+      (let* ((char (%read-char/no-eof db))
+            (chars (cons char chars)))
+       (if (char=? #\; char)
+           (begin
+             (if (not (unicode-scalar-value? sv))
+                 (ill-formed-hex chars))
+             (integer->char sv))
+           (let ((digit (char->digit char 16)))
+             (if (not digit)
+                 (ill-formed-hex chars))
+             (parse-hex-escape (+ (* sv #x10) digit) chars)))))
+
+    (define (ill-formed-hex chars)
+      (error:illegal-string-escape
+       (list->string (cons* #\\ #\x (reverse chars)))))
+
+    (define (parse-octal-escape c1 d1)
+      (let* ((c2 (%read-char/no-eof db))
+            (d2 (char->digit c2 8))
+            (c3 (%read-char/no-eof db))
+            (d3 (char->digit c3 8)))
+       (if (not (and d2 d3))
+           (error:illegal-string-escape (list->string (list #\\ c1 c2 c3))))
+       (integer->char (fix:+ (fix:lsh (fix:+ (fix:lsh d1 3) d2) 3) d3))))
+
+    (loop)
+    (builder)))
 \f
 (define (handler:false db ctx char1 char2)
   ctx char1
@@ -743,17 +743,16 @@ USA.
            (at-end?))
        char
        (name->char
-        (call-with-output-string
-          (lambda (port*)
-            (write-char char port*)
-            (let loop ()
-              (write-char (let ((char (%read-char/no-eof db)))
-                            (if (char=? char #\\)
-                                (%read-char/no-eof db)
-                                char))
-                          port*)
-              (if (not (at-end?))
-                  (loop)))))
+        (let ((builder (string-builder)))
+          (builder char)
+          (let loop ()
+            (builder (let ((char (%read-char/no-eof db)))
+                       (if (char=? char #\\)
+                           (%read-char/no-eof db)
+                           char)))
+            (if (not (at-end?))
+                (loop)))
+          (builder))
         (db-fold-case? db)))))
 \f
 (define (handler:named-constant db ctx char1 char2)
@@ -781,14 +780,14 @@ USA.
 (define (handler:uri db ctx char1 char2)
   ctx char1 char2
   (string->uri
-   (call-with-output-string
-     (lambda (port*)
-       (let loop ()
-        (let ((char (%read-char/no-eof db)))
-          (if (not (char=? char #\>))
-              (begin
-                (write-char char port*)
-                (loop)))))))))
+   (let ((builder (string-builder)))
+     (let loop ()
+       (let ((char (%read-char/no-eof db)))
+        (if (not (char=? char #\>))
+            (begin
+              (builder char)
+              (loop)))))
+     (builder))))
 
 (define (handler:special-arg db ctx char1 char2)
   ctx char1