On Sun, 2014-10-05 at 13:17 +0200, Jan Moringen wrote:

> The patch adds the functions
> COPY-STREAM-CONTENT-INTO-{STRING,BYTE-VECTOR} which implement this
> feature. Despite the new toplevel functions, little new code is
> introduced since R-F-I-{S,B-V} can be implemented in terms of the new
> functions.

I missed that COPY-STREAM-CONTENT-INTO-BYTE-VECTOR called FILE-LENGTH,
pretty much defeating its purpose. Attached is an improved version that
is as efficient as before when the stream length is known and
geometrically grows the output buffer otherwise.

Sorry and kind regards,
Jan
From 7c7d2074cdd14c6605e253cdf84c2ac89ee4492e Mon Sep 17 00:00:00 2001
From: Jan Moringen <jmori...@techfak.uni-bielefeld.de>
Date: Mon, 18 Jun 2012 19:28:18 +0200
Subject: [PATCH] add COPY-STREAM-CONTENT-INTO-{STRING,BYTE-VECTOR}

  export and document them

  use them in READ-FILE-INTO-{STRING,BYTE-VECTOR}
---
 doc/alexandria.texinfo |  2 ++
 io.lisp                | 44 ++++++++++++++++++++++++++++++++------------
 package.lisp           |  2 ++
 3 files changed, 36 insertions(+), 12 deletions(-)

diff --git a/doc/alexandria.texinfo b/doc/alexandria.texinfo
index 4468b0e..89b03ac 100644
--- a/doc/alexandria.texinfo
+++ b/doc/alexandria.texinfo
@@ -209,7 +209,9 @@ terms and conditions:
 @comment  node-name,   next,  previous,  up
 @chapter IO
 
+@include include/fun-alexandria-read-stream-content-into-string.texinfo
 @include include/fun-alexandria-read-file-into-string.texinfo
+@include include/fun-alexandria-read-stream-content-into-byte-vector.texinfo
 @include include/fun-alexandria-read-file-into-byte-vector.texinfo
 
 @node Macro Writing
diff --git a/io.lisp b/io.lisp
index 52551c7..a617d95 100644
--- a/io.lisp
+++ b/io.lisp
@@ -50,6 +50,16 @@ which is only sent to WITH-OPEN-FILE when it's not NIL."
   `(with-open-file* (,stream-name ,file-name :direction :output ,@args)
      ,@body))
 
+(defun read-stream-content-into-string (stream &key (buffer-size 4096))
+  "Return the \"contents\" of STREAM as a fresh string."
+  (let ((*print-pretty* nil))
+    (with-output-to-string (datum)
+      (let ((buffer (make-array buffer-size :element-type 'character)))
+        (loop
+          :for bytes-read = (read-sequence buffer stream)
+          :do (write-sequence buffer datum :start 0 :end bytes-read)
+          :while (= bytes-read buffer-size))))))
+
 (defun read-file-into-string (pathname &key (buffer-size 4096) external-format)
   "Return the contents of the file denoted by PATHNAME as a fresh string.
 
@@ -57,13 +67,7 @@ The EXTERNAL-FORMAT parameter will be passed directly to WITH-OPEN-FILE
 unless it's NIL, which means the system default."
   (with-input-from-file
       (file-stream pathname :external-format external-format)
-    (let ((*print-pretty* nil))
-      (with-output-to-string (datum)
-        (let ((buffer (make-array buffer-size :element-type 'character)))
-	  (loop
-	     :for bytes-read = (read-sequence buffer file-stream)
-	     :do (write-sequence buffer datum :start 0 :end bytes-read)
-	     :while (= bytes-read buffer-size)))))))
+    (read-stream-content-into-string file-stream :buffer-size buffer-size)))
 
 (defun write-string-into-file (string pathname &key (if-exists :error)
                                                     if-does-not-exist
@@ -77,14 +81,30 @@ unless it's NIL, which means the system default."
                                     :external-format external-format)
     (write-sequence string file-stream)))
 
+(defun read-stream-content-into-byte-vector (stream &key length (initial-size 4096))
+  "Return \"contents\" of STREAM as freshly allocated (unsigned-byte 8) vector."
+  (check-type length (or null non-negative-integer))
+  (do ((buffer (make-array (or length initial-size)
+                           :element-type '(unsigned-byte 8)))
+       (offset 0)
+       (offset-wanted 0))
+      ((or (/= offset-wanted offset)
+           (and length (>= offset length)))
+       (if (= offset (length buffer))
+           buffer
+           (subseq buffer 0 offset)))
+    (unless (zerop offset)
+      (let ((new-buffer (make-array (* 2 (length buffer))
+                                    :element-type '(unsigned-byte 8))))
+        (replace new-buffer buffer)
+        (setf buffer new-buffer)))
+    (setf offset-wanted (length buffer)
+          offset (read-sequence buffer stream :start offset))))
+
 (defun read-file-into-byte-vector (pathname)
   "Read PATHNAME into a freshly allocated (unsigned-byte 8) vector."
   (with-input-from-file (stream pathname :element-type '(unsigned-byte 8))
-    (let ((length (file-length stream)))
-      (assert length)
-      (let ((result (make-array length :element-type '(unsigned-byte 8))))
-        (read-sequence result stream)
-        result))))
+    (read-stream-content-into-byte-vector stream :length (file-length stream))))
 
 (defun write-byte-vector-into-file (bytes pathname &key (if-exists :error)
                                                        if-does-not-exist)
diff --git a/package.lisp b/package.lisp
index cf258fc..180e7e9 100644
--- a/package.lisp
+++ b/package.lisp
@@ -226,8 +226,10 @@
    ;; io
    #:with-input-from-file
    #:with-output-to-file
+   #:read-stream-content-into-string
    #:read-file-into-string
    #:write-string-into-file
+   #:read-stream-content-into-byte-vector
    #:read-file-into-byte-vector
    #:write-byte-vector-into-file
    #:copy-stream
-- 
2.1.1

_______________________________________________
Alexandria-devel mailing list
Alexandria-devel@common-lisp.net
http://common-lisp.net/cgi-bin/mailman/listinfo/alexandria-devel

Reply via email to