Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-03 19:26: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

37
lib/scheme/extras.scm
View file

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