Refactor reader.
* module/mes/read-0.mes (eat-whitespace): More efficient ordering/peeking. * module/mes/read-0.mes (read-word): Handle tab.
This commit is contained in:
parent
b45a3b6f33
commit
a0caca6409
|
@ -133,29 +133,30 @@
|
||||||
(cons (quote cond) (cdr clauses))))))
|
(cons (quote cond) (cdr clauses))))))
|
||||||
|
|
||||||
(define (eat-whitespace)
|
(define (eat-whitespace)
|
||||||
(cond
|
((lambda (c)
|
||||||
((eq? (peek-byte) 9) (read-byte) (eat-whitespace))
|
(cond
|
||||||
((eq? (peek-byte) 10) (read-byte) (eat-whitespace))
|
((eq? c 32) (read-byte) (eat-whitespace))
|
||||||
((eq? (peek-byte) 12) (read-byte) (eat-whitespace))
|
((eq? c 10) (read-byte) (eat-whitespace))
|
||||||
((eq? (peek-byte) 13) (read-byte) (eat-whitespace))
|
((eq? c 9) (read-byte) (eat-whitespace))
|
||||||
((eq? (peek-byte) 32) (read-byte) (eat-whitespace))
|
((eq? c 12) (read-byte) (eat-whitespace))
|
||||||
((eq? (peek-byte) 59) (begin (read-line-comment (read-byte))
|
((eq? c 13) (read-byte) (eat-whitespace))
|
||||||
(eat-whitespace)))
|
((eq? c 59) (begin (read-line-comment (read-byte))
|
||||||
((eq? (peek-byte) 35) (begin (read-byte)
|
(eat-whitespace)))
|
||||||
(cond ((eq? (peek-byte) 33)
|
((eq? c 35) (begin (read-byte)
|
||||||
(read-byte)
|
(cond ((eq? (peek-byte) 33)
|
||||||
(read-block-comment 33 (read-byte))
|
(read-byte)
|
||||||
(eat-whitespace))
|
(read-block-comment 33 (read-byte))
|
||||||
((eq? (peek-byte) 59)
|
(eat-whitespace))
|
||||||
(read-byte)
|
((eq? (peek-byte) 59)
|
||||||
(read-word (read-byte) (list) (list))
|
(read-byte)
|
||||||
(eat-whitespace))
|
(read-word (read-byte) (list) (list))
|
||||||
((eq? (peek-byte) 124)
|
(eat-whitespace))
|
||||||
(read-byte)
|
((eq? (peek-byte) 124)
|
||||||
(read-block-comment 124 (read-byte))
|
(read-byte)
|
||||||
(eat-whitespace))
|
(read-block-comment 124 (read-byte))
|
||||||
(#t (unread-byte 35)))
|
(eat-whitespace))
|
||||||
))))
|
(#t (unread-byte 35)))))))
|
||||||
|
(peek-byte)))
|
||||||
|
|
||||||
(define (read-block-comment s c)
|
(define (read-block-comment s c)
|
||||||
(if (eq? c s) (if (eq? (peek-byte) 35) (read-byte)
|
(if (eq? c s) (if (eq? (peek-byte) 35) (read-byte)
|
||||||
|
@ -185,11 +186,11 @@
|
||||||
|
|
||||||
(define (read-word c w a)
|
(define (read-word c w a)
|
||||||
(cond
|
(cond
|
||||||
((eq? c -1) (list))
|
((eq? c 32) (if (null? w) (read-word (read-byte) (list) a)
|
||||||
((eq? c 10) (if (null? w) (read-word (read-byte) (list) a)
|
|
||||||
(lookup w a)))
|
(lookup w a)))
|
||||||
((eq? c 12) (read-word 10 w a))
|
((eq? c 10) (read-word 32 w a))
|
||||||
((eq? c 32) (read-word 10 w a))
|
((eq? c 9) (read-word 32 w a))
|
||||||
|
((eq? c 12) (read-word 32 w a))
|
||||||
((eq? c 34) (if (null? w) (read-string)
|
((eq? c 34) (if (null? w) (read-string)
|
||||||
(begin (unread-byte c) (lookup w a))))
|
(begin (unread-byte c) (lookup w a))))
|
||||||
((eq? c 35) (cond
|
((eq? c 35) (cond
|
||||||
|
@ -238,6 +239,7 @@
|
||||||
(list))))))
|
(list))))))
|
||||||
((eq? c 96) (cons (lookup-char c a) (cons (read-word (read-byte) w a) (list))))
|
((eq? c 96) (cons (lookup-char c a) (cons (read-word (read-byte) w a) (list))))
|
||||||
((eq? c 59) (read-line-comment c) (read-word 10 w a))
|
((eq? c 59) (read-line-comment c) (read-word 10 w a))
|
||||||
|
((eq? c -1) (list))
|
||||||
(#t (read-word (read-byte) (append2 w (cons (integer->char c) (list))) a))))
|
(#t (read-word (read-byte) (append2 w (cons (integer->char c) (list))) a))))
|
||||||
|
|
||||||
((lambda (p)
|
((lambda (p)
|
||||||
|
|
|
@ -46,6 +46,10 @@ barf
|
||||||
burp
|
burp
|
||||||
|#
|
|#
|
||||||
#;(bla) (display "must see!\n")
|
#;(bla) (display "must see!\n")
|
||||||
|
(display
|
||||||
|
(lambda (x)
|
||||||
|
#;()#t)
|
||||||
|
)
|
||||||
(display #(0 1 2)) (newline)
|
(display #(0 1 2)) (newline)
|
||||||
(display (list '(foo
|
(display (list '(foo
|
||||||
#! boo !#
|
#! boo !#
|
||||||
|
@ -53,5 +57,4 @@ burp
|
||||||
)
|
)
|
||||||
))
|
))
|
||||||
(newline)
|
(newline)
|
||||||
|
|
||||||
;; TODO: syntax, unsyntax, unsyntax-splicing
|
;; TODO: syntax, unsyntax, unsyntax-splicing
|
||||||
|
|
Loading…
Reference in a new issue