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

2
scheme/last-revision
View File

@ -1 +1 @@
1168
1169