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

Fixing bounds and multi-chunk stream errors.

Browse source
This commit is contained in:
Alex Shinn 2013-03-04 23:19:37 +09:00
parent 8cd7b9a265
commit 7dc3a63c21
1 changed files with 21 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
lib/chibi/parse/parse.scm
View file

@ -86,7 +86,7 @@
(define (parse-stream-last-char source) (define (parse-stream-last-char source)
(let ((buf (parse-stream-buffer source))) (let ((buf (parse-stream-buffer source)))
(let lp ((i (parse-stream-offset source))) (let lp ((i (min (- (vector-length buf) 1) (parse-stream-offset source))))
(if (negative? i) (if (negative? i)
(parse-stream-prev-char source) (parse-stream-prev-char source)
(let ((ch (vector-ref buf i))) (let ((ch (vector-ref buf i)))
@ -101,7 +101,7 @@
(define (parse-stream-max-char source) (define (parse-stream-max-char source)
(let ((buf (parse-stream-buffer source))) (let ((buf (parse-stream-buffer source)))
(let lp ((i (parse-stream-offset source))) (let lp ((i (min (- (vector-length buf) 1) (parse-stream-offset source))))
(if (or (negative? i) (if (or (negative? i)
(char? (vector-ref buf i))) (char? (vector-ref buf i)))
i i
@ -120,28 +120,39 @@
(define (parse-stream-close source) (define (parse-stream-close source)
(close-input-port (parse-stream-port source))) (close-input-port (parse-stream-port source)))
(define (vector-substring vec start end) (define (vector-substring vec start . o)
(let ((res (make-string (- end start)))) (let* ((end (if (pair? o) (car o) (vector-length vec)))
(res (make-string (- end start))))
(do ((i start (+ i 1))) (do ((i start (+ i 1)))
((= i end) res) ((= i end) res)
(string-set! res (- i start) (vector-ref vec i))))) (string-set! res (- i start) (vector-ref vec i)))))
(define (parse-stream-in-tail? s0 s1)
(let ((s0^ (%parse-stream-tail s0)))
(or (eq? s0^ s1)
(and s0^ (parse-stream-in-tail? s0^ s1)))))
(define (parse-stream< s0 i0 s1 i1)
(if (eq? s0 s1)
(< i0 i1)
(parse-stream-in-tail? s0 s1)))
(define (parse-stream-substring s0 i0 s1 i1) (define (parse-stream-substring s0 i0 s1 i1)
(cond (cond
((eq? s0 s1) ((eq? s0 s1)
(parse-stream-fill! s0 i1) (parse-stream-fill! s0 i1)
(vector-substring (parse-stream-buffer s0) i0 i1)) (vector-substring (parse-stream-buffer s0) i0 i1))
(else (else
(let lp ((s (parse-stream-next-source s0)) (let lp ((s (parse-stream-tail s0))
(res (list (vector-substring (parse-stream-buffer s0) i0 i1)))) (res (list (vector-substring (parse-stream-buffer s0) i0))))
(let ((buf (parse-stream-buffer s))) (let ((buf (parse-stream-buffer s)))
(cond (cond
((eq? s s1) ((eq? s s1)
(apply string-append (apply string-append
(reverse (cons (vector-substring buf 0 i1) res)))) (reverse (cons (vector-substring buf 0 i1) res))))
(else (else
(lp (parse-stream-next-source s) (lp (parse-stream-tail s)
(cons (vector-substring buf 0 (vector-length buf)) res))))))))) (cons (vector-substring buf 0) res)))))))))
(define (parse-stream-cache-cell s i f) (define (parse-stream-cache-cell s i f)
(assv f (vector-ref (parse-stream-cache s) i))) (assv f (vector-ref (parse-stream-cache s) i)))
@ -152,7 +163,8 @@
((assv f cache) ((assv f cache)
=> (lambda (cell) => (lambda (cell)
;; prefer longer matches ;; prefer longer matches
(if (and (pair? (cdr cell)) (< (cadr (cddr cell)) i)) (if (and (pair? (cdr cell))
(parse-stream< (car (cddr cell)) (cadr (cddr cell)) s i))
(set-cdr! cell x)))) (set-cdr! cell x))))
(else (else
(vector-set! (parse-stream-cache s) i (cons (cons f x) cache)))))) (vector-set! (parse-stream-cache s) i (cons (cons f x) cache))))))