moving make-generated-binary-input-port to (chibi io)

This commit is contained in:
Alex Shinn 2017-06-29 14:17:58 +09:00
parent f2f6aadb3d
commit c80a1ece92
4 changed files with 79 additions and 36 deletions

View file

@ -19,6 +19,14 @@
(set! str-ls (cdr str-ls)) (set! str-ls (cdr str-ls))
res))))) 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-begin "io")
(test "input-string-port" 1025 (test "input-string-port" 1025
@ -126,6 +134,32 @@
(read-string 4096 in) (read-string 4096 in)
(read-line 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 ((in (make-custom-binary-input-port
(let ((i 0)) (let ((i 0))
(lambda (bv start end) (lambda (bv start end)

View file

@ -10,8 +10,9 @@
make-custom-binary-input-port make-custom-binary-output-port make-custom-binary-input-port make-custom-binary-output-port
make-null-output-port make-null-input-port make-null-output-port make-null-input-port
make-broadcast-port make-concatenated-port make-broadcast-port make-concatenated-port
make-generated-input-port make-filtered-output-port make-generated-input-port make-generated-binary-input-port
make-filtered-input-port string-count-chars make-filtered-output-port make-filtered-input-port
string-count-chars
open-input-bytevector open-output-bytevector get-output-bytevector open-input-bytevector open-output-bytevector get-output-bytevector
string->utf8 utf8->string string->utf8 utf8->string
write-string write-u8 read-u8 peek-u8 send-file write-string write-u8 read-u8 peek-u8 send-file

View file

@ -391,6 +391,48 @@
(let ((offset2 (string-cursor-copy! str i buf 0 len))) (let ((offset2 (string-cursor-copy! str i buf 0 len)))
(lp (+ i offset2))))))))))))))) (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) ;;> An input port which runs all input (in arbitrary string chunks)
;;> through the \var{filter} procedure. ;;> through the \var{filter} procedure.

View file

@ -51,40 +51,6 @@
n n
(if (>= j len) "" (substring line (+ j 1) len)))))) (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 (http-wrap-chunked-input-port in)
(define (read-chunk in) (define (read-chunk in)
(let* ((line (read-line in)) (let* ((line (read-line in))