6d9143f80df3

--- a/src/basic.lisp	Fri Aug 14 22:56:53 2020 -0400
+++ b/src/basic.lisp	Fri Aug 14 23:06:06 2020 -0400
@@ -28,7 +28,8 @@
   (depth 0 :type (and fixnum (integer 0)))
   (depth-limit *read-depth-limit* :type (and fixnum (integer 0)))
   (size 0 :type (and fixnum (integer 0)))
-  (size-limit *read-size-limit* :type (and fixnum (integer 0))))
+  (size-limit *read-size-limit* :type (and fixnum (integer 0)))
+  (string-buffer nil :type (or null stream)))
 
 (defun p (input &optional (eof :eof)) ; peek
   (declare (type input input)
@@ -267,14 +268,17 @@
   (let ((ch (r input)))
     (unless (eql ch #\")
       (e 'string input "expected opening ~S but got ~S" #\" ch)))
-  (with-output-to-string (s)
-    (loop :for ch = (r input)
-          :do (cond
-                ((eql ch :eof) (e 'string input "got ~S" :eof))
-                ((eql ch #\\) (write-char (parse-escaped-character input) s))
-                ((eql ch #\") (loop-finish))
-                ((requires-escape-p ch) (e 'string input "bad unescaped character ~S" ch))
-                (t (write-char ch s))))))
+  (loop :with s = (or (input-string-buffer input)
+                      (setf (input-string-buffer input)
+                            (make-string-output-stream)))
+        :for ch = (r input)
+        :do (case ch
+              (:eof (e 'string input "got ~S" :eof))
+              (#\\ (write-char (parse-escaped-character input) s))
+              (#\" (return (get-output-stream-string s)))
+              (t (if (requires-escape-p ch)
+                   (e 'string input "bad unescaped character ~S" ch)
+                   (write-char ch s))))))
 
 (defmethod read% ((class (eql 'hash-table)) contained-class input)
   (let ((ch (r input)))