[alexandria.git] updated branch master: e1c8ede Added support for copy-stream for START and END keyword arguments.

[Attila Lendvai]

The branch master has been updated:
       via  e1c8ede0ebaac5026c7dd2e8a1cc450a58455ae5 (commit)
      from  485544d4feb13d3f463f54a5605b3a480bc49046 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit e1c8ede0ebaac5026c7dd2e8a1cc450a58455ae5
Author: Attila Lendvai <attila.lendvai at gmail.com>
Date:   Fri Mar 2 14:13:48 2012 +0600

    Added support for copy-stream for START and END keyword arguments.

-----------------------------------------------------------------------

Summary of changes:
 alexandria.asd |    2 +-
 io.lisp        |   38 +++++++++++++++++++++++++++++++++-----
 2 files changed, 34 insertions(+), 6 deletions(-)

diff --git a/alexandria.asd b/alexandria.asd
index a7efd8e..5277631 100644
--- a/alexandria.asd
+++ b/alexandria.asd
@@ -47,7 +47,7 @@ the following constraints:
    (:file "strings" :depends-on ("package"))
    (:file "conditions" :depends-on ("package"))
    (:file "hash-tables" :depends-on ("package"))
-   (:file "io" :depends-on ("package" "macros" "lists"))
+   (:file "io" :depends-on ("package" "macros" "lists" "types"))
    (:file "macros" :depends-on ("package" "strings" "symbols"))
    (:file "control-flow" :depends-on ("package" "definitions" "macros"))
    (:file "symbols" :depends-on ("package"))
diff --git a/io.lisp b/io.lisp
index 59d6a8c..637c9be 100644
--- a/io.lisp
+++ b/io.lisp
@@ -107,17 +107,45 @@ unless it's NIL, which means the system default."
 (defun copy-stream (input output &key (element-type (stream-element-type input))
                     (buffer-size 4096)
                     (buffer (make-array buffer-size :element-type element-type))
+                    (start 0) end
                     finish-output)
   "Reads data from INPUT and writes it to OUTPUT. Both INPUT and OUTPUT must
 be streams, they will be passed to READ-SEQUENCE and WRITE-SEQUENCE and must have
 compatible element-types."
-  (let ((bytes-written 0))
+  (check-type start non-negative-integer)
+  (check-type end (or null non-negative-integer))
+  (check-type buffer-size positive-integer)
+  (when (< end start)
+    (error "END is smaller than START in ~S" 'copy-stream))
+  (let ((output-position 0)
+        (input-position 0))
+    (unless (zerop start)
+      ;; FIXME add platform specific optimization to skip seekable streams
+      (loop
+        :while (< input-position start)
+        :for bytes-read = (read-sequence buffer input
+                                         :end (min (length buffer)
+                                                   (- start input-position)))
+        :do (progn
+              (when (zerop bytes-read)
+                (error "Could not read enough bytes from the input to fulfill the START requirement in ~S" 'copy-stream))
+              (incf input-position bytes-read))))
+    (assert (= input-position start))
     (loop
-      :for bytes-read = (read-sequence buffer input)
-      :until (zerop bytes-read)
+      :while (or (null end)
+                 (< input-position end))
+      :for bytes-read = (read-sequence buffer input
+                                       :end (when end
+                                              (min (length buffer)
+                                                   (- end input-position))))
       :do (progn
+            (when (zerop bytes-read)
+              (if end
+                  (error "Could not read enough bytes from the input to fulfill the END requirement in ~S" 'copy-stream)
+                  (return)))
+            (incf input-position bytes-read)
             (write-sequence buffer output :end bytes-read)
-            (incf bytes-written bytes-read)))
+            (incf output-position bytes-read)))
     (when finish-output
       (finish-output output))
-    bytes-written))
+    output-position))
-- 
Alexandria hooks/post-receive