Refactor reader.
* module/mes/read-0.mes (read-hash): New function. (read-word): Use it. (eat-whitespace): Rewrite. (display): Minimal implementation through core. * lib.c (stderr_): Support printing of strings while booting.
This commit is contained in:
Jan Nieuwenhuizen
parent
7cb8aea66f
commit
49f1c4e5f3
1
mes.c
1
mes.c
|
|
@ -101,6 +101,7 @@ scm scm_symbol_call_with_values = {SYMBOL, "call-with-values"};
|
|||
scm scm_symbol_current_module = {SYMBOL, "current-module"};
|
||||
scm scm_symbol_primitive_load = {SYMBOL, "primitive-load"};
|
||||
scm scm_symbol_read_input_file = {SYMBOL, "read-input-file"};
|
||||
scm scm_symbol_write = {SYMBOL, "write"};
|
||||
scm scm_symbol_display = {SYMBOL, "display"};
|
||||
|
||||
scm scm_symbol_car = {SYMBOL, "car"};
|
||||
|
|
|
|||
|
|
@ -108,8 +108,8 @@
|
|||
(define <cell:keyword> 3)
|
||||
(define <cell:string> 9)
|
||||
|
||||
(define (newline) (core:stderr (integer->char 10)))
|
||||
(define (display x . reset) #f)
|
||||
(define (newline . rest) (core:stderr (list->string (list (integer->char 10)))))
|
||||
(define (display x . rest) (core:stderr x))
|
||||
|
||||
(define (list->symbol lst) (make-symbol lst))
|
||||
|
||||
|
|
@ -148,31 +148,29 @@
|
|||
(if (pair? (cdr clauses))
|
||||
(cons (quote cond) (cdr clauses))))))
|
||||
|
||||
(define (eat-whitespace)
|
||||
((lambda (c)
|
||||
(cond
|
||||
((eq? c 32) (read-byte) (eat-whitespace))
|
||||
((eq? c 10) (read-byte) (eat-whitespace))
|
||||
((eq? c 9) (read-byte) (eat-whitespace))
|
||||
((eq? c 12) (read-byte) (eat-whitespace))
|
||||
((eq? c 13) (read-byte) (eat-whitespace))
|
||||
((eq? c 59) (begin (read-line-comment (read-byte))
|
||||
(eat-whitespace)))
|
||||
((eq? c 35) (begin (read-byte)
|
||||
(cond ((eq? (peek-byte) 33)
|
||||
(read-byte)
|
||||
(read-block-comment 33 (read-byte))
|
||||
(eat-whitespace))
|
||||
((eq? (peek-byte) 59)
|
||||
(read-byte)
|
||||
(read-word (read-byte) (list) (list))
|
||||
(eat-whitespace))
|
||||
((eq? (peek-byte) 124)
|
||||
(read-byte)
|
||||
(read-block-comment 124 (read-byte))
|
||||
(eat-whitespace))
|
||||
(#t (unread-byte 35)))))))
|
||||
(peek-byte)))
|
||||
(define (eat-whitespace c)
|
||||
(cond
|
||||
((eq? c 32) (eat-whitespace (read-byte)))
|
||||
((eq? c 10) (eat-whitespace (read-byte)))
|
||||
((eq? c 9) (eat-whitespace (read-byte)))
|
||||
((eq? c 12) (eat-whitespace (read-byte)))
|
||||
((eq? c 13) (eat-whitespace (read-byte)))
|
||||
((eq? c 59) (begin (read-line-comment c)
|
||||
(eat-whitespace (read-byte))))
|
||||
((eq? c 35) (cond ((eq? (peek-byte) 33)
|
||||
(read-byte)
|
||||
(read-block-comment 33 (read-byte))
|
||||
(eat-whitespace (read-byte)))
|
||||
((eq? (peek-byte) 59)
|
||||
(read-byte)
|
||||
(read-word (read-byte) (list) (list))
|
||||
(eat-whitespace (read-byte)))
|
||||
((eq? (peek-byte) 124)
|
||||
(read-byte)
|
||||
(read-block-comment 124 (read-byte))
|
||||
(eat-whitespace (read-byte)))
|
||||
(#t (unread-byte 35))))
|
||||
(#t (unread-byte c))))
|
||||
|
||||
(define (read-block-comment s c)
|
||||
(if (eq? c s) (if (eq? (peek-byte) 35) (read-byte)
|
||||
|
|
@ -184,7 +182,7 @@
|
|||
(read-line-comment (read-byte))))
|
||||
|
||||
(define (read-list a)
|
||||
(eat-whitespace)
|
||||
(eat-whitespace (read-byte))
|
||||
(if (eq? (peek-byte) 41) (begin (read-byte) (list))
|
||||
((lambda (w)
|
||||
(if (eq? w *dot*) (car (read-list a))
|
||||
|
|
@ -272,51 +270,47 @@
|
|||
(define (lookup w a)
|
||||
(core:lookup (map1 integer->char w) a))
|
||||
|
||||
(define (read-hash c w a)
|
||||
(cond
|
||||
((eq? c 33) (begin (read-block-comment 33 (read-byte))
|
||||
(read-word (read-byte) w a)))
|
||||
((eq? c 124) (begin (read-block-comment 124 (read-byte))
|
||||
(read-word (read-byte) w a)))
|
||||
((eq? c 40) (list->vector (read-list a)))
|
||||
((eq? c 92) (read-character))
|
||||
((eq? c 120) (read-hex))
|
||||
((eq? c 44) (cond ((eq? (peek-byte) 64)
|
||||
(read-byte)
|
||||
(cons (quote unsyntax-splicing)
|
||||
(cons (read-word (read-byte) w a) w)))
|
||||
(#t (cons (quote unsyntax)
|
||||
(cons (read-word (read-byte) w a) w)))))
|
||||
((eq? c 39) (cons (quote syntax) (cons (read-word (read-byte) w a) w)))
|
||||
((eq? c 58) (symbol->keyword (read-word (read-byte) w a)))
|
||||
((eq? c 59) (begin (read-word (read-byte) w a)
|
||||
(read-word (read-byte) w a)))
|
||||
((eq? c 96) (cons (quote quasisyntax)
|
||||
(cons (read-word (read-byte) w a) w)))
|
||||
(#t (read-word c (append2 w (cons 35 w)) a))))
|
||||
|
||||
(define (read-word c w a)
|
||||
(cond
|
||||
((eq? c 32) (if (null? w) (read-word (read-byte) (list) a) (lookup w a)))
|
||||
((eq? c 10) (read-word 32 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)
|
||||
(begin (unread-byte c) (lookup w a))))
|
||||
((eq? c 35) (cond
|
||||
((eq? (peek-byte) 33) (begin (read-byte)
|
||||
(read-block-comment 33 (read-byte))
|
||||
(read-word (read-byte) w a)))
|
||||
((eq? (peek-byte) 124) (begin (read-byte)
|
||||
(read-block-comment 124 (read-byte))
|
||||
(read-word (read-byte) w a)))
|
||||
((eq? (peek-byte) 40) (read-byte) (list->vector (read-list a)))
|
||||
((eq? (peek-byte) 92) (read-byte) (read-character))
|
||||
((eq? (peek-byte) 120) (read-byte) (read-hex))
|
||||
((eq? (peek-byte) 44)
|
||||
(read-byte)
|
||||
(cond ((eq? (peek-byte) 64)
|
||||
(read-byte)
|
||||
(cons (quote unsyntax-splicing)
|
||||
(cons (read-word (read-byte) w a) (list))))
|
||||
(#t
|
||||
(cons (quote unsyntax)
|
||||
(cons (read-word (read-byte) w a) (list))))))
|
||||
((eq? (peek-byte) 39) (read-byte)
|
||||
(cons (quote syntax) (cons (read-word (read-byte) w a) (list))))
|
||||
((eq? (peek-byte) 58) (read-byte)
|
||||
(symbol->keyword (read-word (read-byte) (list) a)))
|
||||
((eq? (peek-byte) 59) (read-byte)
|
||||
(read-word (read-byte) w a)
|
||||
(read-word (read-byte) w a))
|
||||
((eq? (peek-byte) 96) (read-byte)
|
||||
(cons (quote quasisyntax)
|
||||
(cons (read-word (read-byte) w a) (list))))
|
||||
(#t (read-word (read-byte) (append2 w (cons c (list))) a))))
|
||||
((eq? c 39) (if (null? w) (cons (quote quote)
|
||||
(cons (read-word (read-byte) w a) (list)))
|
||||
(begin (unread-byte c) (lookup w a))))
|
||||
((or (and (> c 96) (< c 123))
|
||||
(eq? c 45)
|
||||
(eq? c 63)
|
||||
(and (> c 47) (< c 58))) (read-word (read-byte) (append2 w (cons c (list))) a))
|
||||
((eq? c 40) (if (null? w) (read-list a)
|
||||
(begin (unread-byte c) (lookup w a))))
|
||||
((eq? c 41) (if (null? w) (quote *FOOBAR*)
|
||||
(begin (unread-byte c) (lookup w a))))
|
||||
((eq? c 34) (if (null? w) (read-string)
|
||||
(begin (unread-byte c) (lookup w a))))
|
||||
((eq? c 32) (if (null? w) (read-word (read-byte) (list) a) (lookup w a)))
|
||||
((eq? c 10) (if (null? w) (read-word (read-byte) (list) a) (lookup w a)))
|
||||
((eq? c 35) (read-hash (read-byte) w a))
|
||||
((eq? c 39) (if (null? w) (cons (quote quote)
|
||||
(cons (read-word (read-byte) w a) (list)))
|
||||
(begin (unread-byte c) (lookup w a))))
|
||||
((eq? c 44) (cond
|
||||
((eq? (peek-byte) 64)
|
||||
(begin (read-byte)
|
||||
|
|
@ -327,6 +321,8 @@
|
|||
(cons (read-word (read-byte) w a) (list))))))
|
||||
((eq? c 96) (cons (quote quasiquote) (cons (read-word (read-byte) w a) (list))))
|
||||
((eq? c 59) (read-line-comment c) (read-word 10 w a))
|
||||
((eq? c 9) (read-word 32 w a))
|
||||
((eq? c 12) (read-word 32 w a))
|
||||
((eq? c -1) (list))
|
||||
(#t (read-word (read-byte) (append2 w (cons c (list))) a))))
|
||||
|
||||
|
|
|
|||
6
posix.c
6
posix.c
|
|
@ -82,8 +82,10 @@ write_byte (SCM x) ///((arity . n))
|
|||
SCM
|
||||
stderr_ (SCM x)
|
||||
{
|
||||
SCM display;
|
||||
if ((display = assq_ref_cache (cell_symbol_display, r0)) != cell_undefined)
|
||||
SCM write;
|
||||
if (TYPE (x) == STRING)
|
||||
fprintf (stderr, string_to_cstring (x));
|
||||
else if ((write = assq_ref_cache (cell_symbol_write, r0)) != cell_undefined)
|
||||
apply_env (assq_ref_cache (cell_symbol_display, r0), cons (x, cons (MAKE_NUMBER (2), cell_nil)), r0);
|
||||
else if (TYPE (x) == SPECIAL || TYPE (x) == STRING || TYPE (x) == SYMBOL)
|
||||
fprintf (stderr, string_to_cstring (x));
|
||||
|
|
|
|||
Loading…
Reference in a new issue