Add support for reading symbols.
Also remove | and \ from the list of valid symbol characters.
This commit is contained in:
parent
1cd72fc8e0
commit
b993d6617f
|
|
@ -68,6 +68,9 @@
|
||||||
(read-number)]
|
(read-number)]
|
||||||
[(eq? current-char #\")
|
[(eq? current-char #\")
|
||||||
(read-string)]
|
(read-string)]
|
||||||
|
[(eq? current-char #\|)
|
||||||
|
(next-char)
|
||||||
|
(read-symbol #t)]
|
||||||
[(symbol-char? current-char)
|
[(symbol-char? current-char)
|
||||||
(read-symbol)]
|
(read-symbol)]
|
||||||
[else
|
[else
|
||||||
|
|
@ -325,8 +328,37 @@
|
||||||
(iter 0 (cdr items))
|
(iter 0 (cdr items))
|
||||||
struct))
|
struct))
|
||||||
|
|
||||||
(define (read-symbol)
|
(define (read-symbol [quoted? #f])
|
||||||
undefined)
|
(define (read-chars)
|
||||||
|
(cond
|
||||||
|
[eof?
|
||||||
|
(if quoted?
|
||||||
|
(unexpected-eof)
|
||||||
|
'())]
|
||||||
|
[(and quoted? (eq? current-char #\|))
|
||||||
|
(next-char)
|
||||||
|
'()]
|
||||||
|
[(eq? current-char #\\)
|
||||||
|
(next-char)
|
||||||
|
(when eof? (unexpected-eof))
|
||||||
|
(let ([ch current-char])
|
||||||
|
(next-char)
|
||||||
|
(cons ch (read-chars)))]
|
||||||
|
[(or quoted? (symbol-char? current-char))
|
||||||
|
(let ([ch current-char])
|
||||||
|
(next-char)
|
||||||
|
(cons ch (read-chars)))]
|
||||||
|
[else '()]))
|
||||||
|
|
||||||
|
(let* ([chars (read-chars)]
|
||||||
|
[len (list-length chars)]
|
||||||
|
[str (make-byte-string len #\Null)])
|
||||||
|
(define (iter n rst)
|
||||||
|
(when (fix< n len)
|
||||||
|
(byte-string-set! str n (car rst))
|
||||||
|
(iter (fix+ n 1) (cdr rst))))
|
||||||
|
(iter 0 chars)
|
||||||
|
(intern str)))
|
||||||
|
|
||||||
(define (skip-whitespace)
|
(define (skip-whitespace)
|
||||||
(unless eof?
|
(unless eof?
|
||||||
|
|
@ -402,7 +434,7 @@
|
||||||
(or (alphanumeric-char? ch)
|
(or (alphanumeric-char? ch)
|
||||||
(memq? ch '(#\! #\$ #\% #\& #\* #\+
|
(memq? ch '(#\! #\$ #\% #\& #\* #\+
|
||||||
#\- #\/ #\< #\= #\> #\?
|
#\- #\/ #\< #\= #\> #\?
|
||||||
#\@ #\\ #\^ #\_ #\| #\~))))
|
#\@ #\^ #\_ #\~))))
|
||||||
|
|
||||||
(define (reverse lst [newcdr '()])
|
(define (reverse lst [newcdr '()])
|
||||||
(if (pair? lst)
|
(if (pair? lst)
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue