conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Cases in bug 173201 are closed. Still failing read0 though.

This commit is contained in:
Abdulaziz Ghuloum 2007-12-02 06:58:33 -05:00
parent bc2e88e4e7
commit 9d9735ce2a
3 changed files with 100 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
scheme/ikarus.boot.prebuilt
View File

Binary file not shown.

63
scheme/ikarus.reader.ss
View File

@ -77,19 +77,36 @@
(unread-char c p) (unread-char c p)
(error 'tokenize "invalid identifier syntax" (error 'tokenize "invalid identifier syntax"
(list->string (reverse (cons c ls))))])))) (list->string (reverse (cons c ls))))]))))
(define tokenize-string (define (tokenize-string ls p)
(lambda (ls p)
(define (intraline-whitespace? c)
(or (eqv? c #\x9)
(eq? (char-general-category c) 'Zs)))
(let ([c (read-char p)]) (let ([c (read-char p)])
(cond (cond
[(eof-object? c) [(eof-object? c)
(error 'tokenize "end-of-file while inside a string")] (error 'tokenize "invalid eof inside string")]
[else (tokenize-string-char ls p c)])))
(define (tokenize-string-char ls p c)
(define (intraline-whitespace? c)
(or (eqv? c #\x9)
(eq? (char-general-category c) 'Zs)))
(define (tokenize-string-continue ls p c)
(cond
[(eof-object? c)
(error 'tokenize "invalid eof inside string")]
[(intraline-whitespace? c)
(let f ()
(let ([c (read-char p)])
(cond
[(eof-object? c)
(error 'tokenize "invalid eof inside string")]
[(intraline-whitespace? c) (f)]
[else (tokenize-string-char ls p c)])))]
[else (tokenize-string-char ls p c)]))
(cond
[($char= #\" c) ls] [($char= #\" c) ls]
[($char= #\\ c) [($char= #\\ c)
(let ([c (read-char p)]) (let ([c (read-char p)])
(cond (cond
[(eof-object? c)
(error 'tokenize "invalid eof after string escape")]
[($char= #\a c) (tokenize-string (cons #\x7 ls) p)] [($char= #\a c) (tokenize-string (cons #\x7 ls) p)]
[($char= #\b c) (tokenize-string (cons #\x8 ls) p)] [($char= #\b c) (tokenize-string (cons #\x8 ls) p)]
[($char= #\t c) (tokenize-string (cons #\x9 ls) p)] [($char= #\t c) (tokenize-string (cons #\x9 ls) p)]
@ -123,26 +140,34 @@
[else [else
(error 'tokenize (error 'tokenize
"invalid char in escape sequence" c)]))] "invalid char in escape sequence" c)]))]
[(eof-object? c)
(error 'tokenize "invalid eof after string escape")]
[(intraline-whitespace? c) [(intraline-whitespace? c)
(let ([c (let f ()
(let ([c (read-char p)]) (let ([c (read-char p)])
(cond (cond
[(memv c '(#\xA #\x85 #\x2028)) (read-char p)] [(eof-object? c)
(error 'tokenize "invalid eof inside string")]
[(intraline-whitespace? c) (f)]
[(memv c '(#\xA #\x85 #\x2028))
(tokenize-string-continue ls p (read-char p))]
[(memv c '(#\xD)) [(memv c '(#\xD))
(let ([c (read-char p)]) (let ([c (read-char p)])
(cond (cond
[(memv c '(#\A #\x85)) [(memv c '(#\xA #\x85))
(read-char p)] (tokenize-string-continue ls p (read-char p))]
[else c]))] [else
(tokenize-string-continue ls p c)]))]
[else [else
(error 'tokenize (error 'tokenize
"expected line ending inside string")]))]) "non-whitespace character after escape")])))]
(unless (and (char? c) (intraline-whitespace? c)) [(memv c '(#\xA #\x85 #\x2028))
(error 'tokenize (tokenize-string-continue ls p (read-char p))]
"expected an intraline whitespace inside a string")) [(memv c '(#\xD))
(tokenize-string ls p))] (let ([c (read-char p)])
(cond
[(memv c '(#\xA #\x85))
(tokenize-string-continue ls p (read-char p))]
[else
(tokenize-string-continue ls p c)]))]
[else (error 'tokenize "invalid string escape" c)]))] [else (error 'tokenize "invalid string escape" c)]))]
[(memv c '(#\xA #\x85 #\x2028)) [(memv c '(#\xA #\x85 #\x2028))
(tokenize-string (cons #\linefeed ls) p)] (tokenize-string (cons #\linefeed ls) p)]
@ -152,7 +177,7 @@
(read-char p)) (read-char p))
(tokenize-string (cons #\linefeed ls) p))] (tokenize-string (cons #\linefeed ls) p))]
[else [else
(tokenize-string (cons c ls) p)])))) (tokenize-string (cons c ls) p)]))
(define skip-comment (define skip-comment
(lambda (p) (lambda (p)
(let ([c (read-char p)]) (let ([c (read-char p)])

2
scheme/last-revision
View File

@ -1 +1 @@
1168 1169