From c80a1ece9259cb224cb37cebfccdf41bb7408f0c Mon Sep 17 00:00:00 2001
From: Alex Shinn <alexshinn@gmail.com>
Date: Thu, 29 Jun 2017 14:17:58 +0900
Subject: [PATCH] moving make-generated-binary-input-port to (chibi io)

---
 lib/chibi/io-test.sld  | 34 ++++++++++++++++++++++++++++++++++
 lib/chibi/io.sld       |  5 +++--
 lib/chibi/io/io.scm    | 42 ++++++++++++++++++++++++++++++++++++++++++
 lib/chibi/net/http.scm | 34 ----------------------------------
 4 files changed, 79 insertions(+), 36 deletions(-)

diff --git a/lib/chibi/io-test.sld b/lib/chibi/io-test.sld
index 1374e651..a4f22836 100644
--- a/lib/chibi/io-test.sld
+++ b/lib/chibi/io-test.sld
@@ -19,6 +19,14 @@
                   (set! str-ls (cdr str-ls))
                   res)))))
 
+      (define (bytevectors->input-port bv-ls)
+        (make-generated-binary-input-port
+         (lambda ()
+           (and (pair? bv-ls)
+                (let ((res (car bv-ls)))
+                  (set! bv-ls (cdr bv-ls))
+                  res)))))
+
       (test-begin "io")
 
       (test "input-string-port" 1025
@@ -126,6 +134,32 @@
             (read-string 4096 in)
             (read-line in)))
 
+      (test #u8(0 1 2)
+        (let ((in (bytevectors->input-port (list #u8(0 1 2)))))
+          (read-bytevector 3 in)))
+
+      (test #u8(0 1 2 3 4 5)
+        (let ((in (bytevectors->input-port (list #u8(0 1 2) #u8(3 4 5)))))
+          (read-bytevector 6 in)))
+
+      (test #u8(3 4 5)
+        (let ((in (bytevectors->input-port
+                   (list #u8(0 1 2) (make-bytevector 4087 7) #u8(3 4 5)))))
+          (read-bytevector 4090 in)
+          (read-bytevector 3 in)))
+
+      (test #u8(3 4 5)
+        (let ((in (bytevectors->input-port
+                   (list #u8(0 1 2) (make-bytevector 4093 7) #u8(3 4 5)))))
+          (read-bytevector 4096 in)
+          (read-bytevector 3 in)))
+
+      (test #u8(3 4 5)
+        (let ((in (bytevectors->input-port
+                   (list #u8(0 1 2) (make-bytevector 5000 7) #u8(3 4 5)))))
+          (read-bytevector 5003 in)
+          (read-bytevector 3 in)))
+
       (let ((in (make-custom-binary-input-port
                  (let ((i 0))
                    (lambda (bv start end)
diff --git a/lib/chibi/io.sld b/lib/chibi/io.sld
index 2314ac09..40151301 100644
--- a/lib/chibi/io.sld
+++ b/lib/chibi/io.sld
@@ -10,8 +10,9 @@
           make-custom-binary-input-port make-custom-binary-output-port
           make-null-output-port make-null-input-port
           make-broadcast-port make-concatenated-port
-          make-generated-input-port make-filtered-output-port
-          make-filtered-input-port string-count-chars
+          make-generated-input-port make-generated-binary-input-port
+          make-filtered-output-port make-filtered-input-port
+          string-count-chars
           open-input-bytevector open-output-bytevector get-output-bytevector
           string->utf8 utf8->string
           write-string write-u8 read-u8 peek-u8 send-file
diff --git a/lib/chibi/io/io.scm b/lib/chibi/io/io.scm
index 0f6025d4..6f5ef632 100644
--- a/lib/chibi/io/io.scm
+++ b/lib/chibi/io/io.scm
@@ -391,6 +391,48 @@
                  (let ((offset2 (string-cursor-copy! str i buf 0 len)))
                    (lp (+ i offset2)))))))))))))))
 
+(define (%bytevector-copy! to at from start end) ; simplified
+  (do ((i at (+ i 1)) (j start (+ j 1)))
+      ((>= j end))
+    (bytevector-u8-set! to i (bytevector-u8-ref from j))))
+
+;;> Equivalent to \scheme{make-generated-input-port}, but produces a
+;;> binary port, and \var{generator} should return a bytevector or
+;;> \scheme{#f} when there is no more input.
+
+(define (make-generated-binary-input-port generator)
+  (let ((buf #u8())
+        (len 0)
+        (offset 0))
+    (make-custom-binary-input-port
+     (lambda (bv start end)
+       (let ((n (- end start)))
+         (cond
+          ((>= (- len offset) n)
+           (%bytevector-copy! bv start buf offset (+ offset n))
+           (set! offset (+ offset n))
+           (+ start n))
+          (else
+           (%bytevector-copy! bv start buf offset len)
+           (let lp ((i (+ start (- len offset))))
+             (set! buf (generator))
+             (set! offset 0)
+             (cond
+              ((not (bytevector? buf))
+               (set! buf #u8())
+               (set! len 0)
+               i)
+              (else
+               (set! len (bytevector-length buf))
+               (cond
+                ((>= len (- n i))
+                 (%bytevector-copy! bv i buf 0 (- n i))
+                 (set! offset (- n i))
+                 n)
+                (else
+                 (%bytevector-copy! bv i buf 0 len)
+                 (lp (+ i len))))))))))))))
+
 ;;> An input port which runs all input (in arbitrary string chunks)
 ;;> through the \var{filter} procedure.
 
diff --git a/lib/chibi/net/http.scm b/lib/chibi/net/http.scm
index d67e9114..2d3c1c01 100644
--- a/lib/chibi/net/http.scm
+++ b/lib/chibi/net/http.scm
@@ -51,40 +51,6 @@
               n
               (if (>= j len) "" (substring line (+ j 1) len))))))
 
-(define (make-generated-binary-input-port generator)
-  (let ((buf #u8())
-        (len 0)
-        (offset 0))
-    (make-custom-binary-input-port
-     (lambda (bv start end)
-       (let ((n (- end start)))
-         (cond
-          ((>= (- len offset) n)
-           (bytevector-copy! bv start buf offset (+ offset n))
-           (set! offset (+ offset n))
-           end)
-          (else
-           (bytevector-copy! bv start buf offset (+ offset len))
-           (let lp ((i (+ start (- len offset))))
-             (set! buf (generator))
-             (cond
-              ((not (bytevector? buf))
-               (set! buf #u8())
-               (set! len 0)
-               (set! offset 0)
-               i)
-              (else
-               (set! len (bytevector-length buf))
-               (set! offset 0)
-               (cond
-                ((>= (- len offset) (- n i))
-                 (bytevector-copy! bv i buf offset (+ offset (- n i)))
-                 (set! offset (+ offset (- n i)))
-                 end)
-                (else
-                 (bytevector-copy! bv i buf offset len)
-                 (lp (+ i (- len offset)))))))))))))))
-
 (define (http-wrap-chunked-input-port in)
   (define (read-chunk in)
     (let* ((line (read-line in))