andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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:
Jan Nieuwenhuizen 2016-12-25 12:37:35 +01:00
parent b45a3b6f33
commit a0caca6409
2 changed files with 34 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
module/mes/read-0.mes
View File

@ -133,30 +133,31 @@
(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)
(read-block-comment s (read-byte))) (read-block-comment s (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)

5
tests/read.test
View File

@ -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