Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Avoid needless allocation in read-bytevector!

Browse source 
This change switches the implementation strategy to basing
read-bytevector on top of read-bytevector! rather than the other way
around.
This commit is contained in:
Vasilij Schneidermann 2024-03-17 19:47:30 +01:00
parent b303bf3611
commit d0e6dc7556
1 changed files with 13 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
lib/scheme/extras.scm
View file

@ -136,15 +136,8 @@
#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))) (res (make-bytevector n)))
(let lp ((i 0)) (read-bytevector! res in)
(if (>= i n) res)))
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))))))))))
(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 +145,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)))