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

Bugfixes for make-generated-input-port on unicode strings.

Browse source 
The argument to make-custom-input-port takes and returns offset values,
not string indexes.
This commit is contained in:
Alex Shinn 2015-01-17 19:05:28 +09:00
parent d3cbc89996
commit 0f1254a4cc
1 changed files with 26 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

45
lib/chibi/io/io.scm
View file

@ -9,10 +9,17 @@
(call-with-input-string " " (call-with-input-string " "
(lambda (in) (read-char in) (read-char in)))) (lambda (in) (read-char in) (read-char in))))
(define (string-copy! dst start src from to) ;; Copy whole characters from the given cursor positions.
(do ((i from (+ i 1)) (j start (+ j 1))) ;; Return the src cursor position of the next unwritten char,
((>= i to)) ;; which may be before `to' if the char would overflow.
(string-set! dst j (string-ref src i)))) (define (string-cursor-copy! dst start src from to)
(let lp ((i from)
(j (string-offset->index dst start)))
(let ((i2 (string-cursor-next src i)))
(cond ((> i2 to) i)
(else
(string-set! dst j (string-cursor-ref src i))
(lp i2 (+ j 1)))))))
(define (utf8->string vec . o) (define (utf8->string vec . o)
(if (pair? o) (if (pair? o)
@ -325,7 +332,7 @@
(let* ((s (read-string (- n i) (car ports))) (let* ((s (read-string (- n i) (car ports)))
(len (if (string? s) (string-length s) 0))) (len (if (string? s) (string-length s) 0)))
(if (and (string? str) (> len 0)) (if (and (string? str) (> len 0))
(string-copy! str i s 0 len)) (string-cursor-copy! str i s 0 len))
(lp (+ i len))))))))))))) (lp (+ i len)))))))))))))
;;> A /dev/null input port which always returns \scheme{eof-object}. ;;> A /dev/null input port which always returns \scheme{eof-object}.
@ -347,12 +354,13 @@
(let ((n (- end start))) (let ((n (- end start)))
(cond (cond
((>= (- len offset) n) ((>= (- len offset) n)
(string-copy! str start buf offset (+ offset n)) (let* ((offset2
(set! offset (+ offset n)) (string-cursor-copy! str start buf offset (+ offset n)))
(- (string-index->offset str end) (end2 (+ (- offset2 offset) start)))
(string-index->offset str start))) (set! offset offset2)
end2))
(else (else
(string-copy! str start buf offset len) (string-cursor-copy! str start buf offset len)
(let lp ((i (+ start (- len offset)))) (let lp ((i (+ start (- len offset))))
(set! buf (generator)) (set! buf (generator))
(cond (cond
@ -360,20 +368,19 @@
(set! buf "") (set! buf "")
(set! len 0) (set! len 0)
(set! offset 0) (set! offset 0)
(- (string-index->offset str i) (+ i start))
(string-index->offset str start)))
(else (else
(set! len (string-length buf)) (set! len (string-size buf))
(set! offset 0) (set! offset 0)
(cond (cond
((>= (- len offset) (- n i)) ((>= (- len offset) (- n i))
(string-copy! str i buf 0 (- n i)) (let* ((offset2 (string-cursor-copy! str i buf 0 (- n i)))
(set! offset (- n i)) (end2 (+ (- offset2 offset) start)))
(- (string-index->offset str end) (set! offset offset2)
(string-index->offset str start))) end2))
(else (else
(string-copy! str i buf offset len) (let ((offset2 (string-cursor-copy! str i buf offset len)))
(lp (+ i (- len offset))))))))))))))) (lp (+ i (- offset2 offset))))))))))))))))
;;> 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.