mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-18 21:29:19 +02:00
moving make-generated-binary-input-port to (chibi io)
This commit is contained in:
parent
f2f6aadb3d
commit
c80a1ece92
4 changed files with 79 additions and 36 deletions
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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.
|
||||||
|
|
||||||
|
|
|
@ -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))
|
||||||
|
|
Loading…
Add table
Reference in a new issue