Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-04 03:36:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

Merge pull request #950 from wasamasa/optimize-read-bytevector

Browse source 
Avoid needless allocation in read-bytevector!
This commit is contained in:
Alex Shinn 2024-03-18 11:56:21 +09:00 • committed by GitHub
commit 5b19aab107
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
1 changed files with 17 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
lib/scheme/extras.scm
View file

@ -134,17 +134,12 @@
(define (read-bytevector n . o) (define (read-bytevector n . o)
(if (zero? n) (if (zero? n)
#u8() #u8()
(let ((in (if (pair? o) (car o) (current-input-port))) (let* ((in (if (pair? o) (car o) (current-input-port)))
(res (make-bytevector n))) (vec (make-bytevector n))
(let lp ((i 0)) (res (read-bytevector! vec in)))
(if (>= i n) (cond ((eof-object? res) res)
res ((< res n) (subbytes vec 0 res))
(let ((x (read-u8 in))) (else vec)))))
(cond ((eof-object? x)
(if (zero? i) x (subbytes res 0 i)))
(else
(bytevector-u8-set! res i x)
(lp (+ i 1))))))))))
(define (read-bytevector! vec . o) (define (read-bytevector! vec . o)
(let* ((in (if (pair? o) (car o) (current-input-port))) (let* ((in (if (pair? o) (car o) (current-input-port)))
@ -152,19 +147,19 @@
(start (if (pair? o) (car o) 0)) (start (if (pair? o) (car o) 0))
(end (if (and (pair? o) (pair? (cdr o))) (end (if (and (pair? o) (pair? (cdr o)))
(cadr o) (cadr o)
(bytevector-length vec)))) (bytevector-length vec)))
(n (- end start)))
(if (>= start end) (if (>= start end)
0 0
(let ((res (read-bytevector (- end start) in))) (let lp ((i 0))
(cond (if (>= i n)
((eof-object? res) i
res) (let ((x (read-u8 in)))
(else (cond ((eof-object? x)
(let ((len (bytevector-length res))) (if (zero? i) x i))
(do ((i 0 (+ i 1))) (else
((>= i len) len) (bytevector-u8-set! vec (+ i start) x)
(bytevector-u8-set! vec (+ i start) (bytevector-u8-ref res i)) (lp (+ i 1))))))))))
))))))))
(define (write-bytevector vec . o) (define (write-bytevector vec . o)
(let* ((out (if (pair? o) (car o) (current-output-port))) (let* ((out (if (pair? o) (car o) (current-output-port)))