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

Mark unterminated strings and symbols in (srfi 38) as read-incomplete errors.

Browse source 
Fixes issue #305.
This commit is contained in:
Alex Shinn 2016-02-02 22:55:30 +09:00
parent 65150a5583
commit 3cf21ee8db
1 changed files with 54 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

59
lib/srfi/38.scm
View file

@ -130,14 +130,26 @@
(if (not (or (eof-object? c) (eqv? c #\newline))) (if (not (or (eof-object? c) (eqv? c #\newline)))
(skip-line in)))) (skip-line in))))
(define (skip-horizontal-whitespace in)
(case (peek-char in)
((#\space #\tab)
(read-char in)
(skip-horizontal-whitespace in))))
(define (skip-whitespace in) (define (skip-whitespace in)
(case (peek-char in) (case (peek-char in)
((#\space #\tab #\newline #\return) ((#\space #\tab #\newline #\return)
(read-char in) (read-char in)
(skip-whitespace in)) (skip-whitespace in))))
(define (skip-whitespace-and-line-comments in)
(case (peek-char in)
((#\space #\tab #\newline #\return)
(read-char in)
(skip-whitespace-and-line-comments in))
((#\;) ((#\;)
(skip-line in) (skip-line in)
(skip-whitespace in)))) (skip-whitespace-and-line-comments in))))
(define (skip-comment in depth) (define (skip-comment in depth)
(case (read-char in) (case (read-char in)
@ -151,7 +163,7 @@
;; returns #f if a trailing # was consumed ;; returns #f if a trailing # was consumed
(define (skip-whitespace-and-sexp-comments in read) (define (skip-whitespace-and-sexp-comments in read)
(skip-whitespace in) (skip-whitespace-and-line-comments in)
(cond (cond
((eqv? #\# (peek-char in)) ((eqv? #\# (peek-char in))
(read-char in) (read-char in)
@ -239,13 +251,44 @@
(read in)) (read in))
(else (else
(read-error "invalid type identifier syntax" ch))))) (read-error "invalid type identifier syntax" ch)))))
(define (read-escape-sequence)
(let ((ch (read-char in)))
(cond
((eof-object? ch) (read-incomplete-error "incomplete escape"))
(else
(case ch
((#\a) #\alarm) ((#\b) #\backspace)
((#\n) #\newline) ((#\r) #\return)
((#\t) #\tab)
((#\newline) (skip-horizontal-whitespace in) #f)
((#\space #\tab)
(skip-line in) (skip-horizontal-whitespace in) #f)
((#\x)
(let* ((n (read-number 16))
(ch2 (read-char in)))
(if (not (and n (eqv? ch2 #\;)))
(read-error "invalid string escape" n ch2)
(integer->char n))))
(else ch))))))
(define (read-delimited terminal)
(let ((out (open-output-string)))
(let lp ()
(let ((ch (read-char in)))
(cond
((eof-object? ch) (read-incomplete-error "incomplete string"))
((eqv? ch terminal) (get-output-string out))
((eqv? ch #\\)
(let ((ch2 (read-escape-sequence)))
(if ch2 (write-char ch2 out))
(lp)))
(else (write-char ch out) (lp)))))))
(define (read-object) (define (read-object)
(let ((name (read-name #f in))) (let ((name (read-name #f in)))
(skip-whitespace in) (skip-whitespace-and-line-comments in)
(let* ((id (read-type-id in)) (let* ((id (read-type-id in))
(type (lookup-type name id))) (type (lookup-type name id)))
(let lp ((ls '())) (let lp ((ls '()))
(skip-whitespace in) (skip-whitespace-and-line-comments in)
(cond (cond
((eof-object? (peek-char in)) ((eof-object? (peek-char in))
(read-error "missing closing }")) (read-error "missing closing }"))
@ -401,6 +444,12 @@
((#\{) ((#\{)
(read-char in) (read-char in)
(read-object)) (read-object))
((#\")
(read-char in)
(read-delimited #\"))
((#\|)
(read-char in)
(string->symbol (read-delimited #\|)))
((#\') (read-char in) (list 'quote (read-one in))) ((#\') (read-char in) (list 'quote (read-one in)))
((#\`) (read-char in) (list 'quasiquote (read-one in))) ((#\`) (read-char in) (list 'quasiquote (read-one in)))
((#\,) ((#\,)