artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Support non-nested #| |# comment.

Browse source 
* module/mes/read-0.mes (read-word, read-block-comment): Implement #|.
* reader.c (read_word, read_block_comment)[READER]: Likewise.
* tests/read.test: Test it.
* NEWS: Mention it.
This commit is contained in:
Jan Nieuwenhuizen 2016-12-18 10:11:22 +01:00
parent 9dcff14bba
commit 95d913097d
4 changed files with 27 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
NEWS
View file

@ -21,6 +21,7 @@ block-comments are all handled by the Scheme reader later.
*** Cond now supports =>. *** Cond now supports =>.
*** Lambda* and define* are now supported. *** Lambda* and define* are now supported.
*** #;-comment is now supported. *** #;-comment is now supported.
*** Non-nested #| |#-comment is now supported.
* Changes in 0.3 since 0.2 * Changes in 0.3 since 0.2
** Core ** Core
*** Number-based rather than pointer-based cells. *** Number-based rather than pointer-based cells.

25
module/mes/read-0.mes
View file

@ -74,15 +74,21 @@
((eq? (peek-byte) 59) (begin (read-line-comment (read-byte)) ((eq? (peek-byte) 59) (begin (read-line-comment (read-byte))
(eat-whitespace))) (eat-whitespace)))
((eq? (peek-byte) 35) (begin (read-byte) ((eq? (peek-byte) 35) (begin (read-byte)
(if (eq? (peek-byte) 33) (begin (read-byte) (cond ((eq? (peek-byte) 33)
(read-block-comment (read-byte)) (read-byte)
(read-block-comment 33 (read-byte))
(eat-whitespace)) (eat-whitespace))
(unread-byte 35)))))) ((eq? (peek-byte) 124)
(read-byte)
(read-block-comment 124 (read-byte))
(eat-whitespace))
(#t (unread-byte 35)))
))))
(define (read-block-comment c) (define (read-block-comment s c)
(if (eq? c 33) (if (eq? (peek-byte) 35) (read-byte) (if (eq? c s) (if (eq? (peek-byte) 35) (read-byte)
(read-block-comment (read-byte))) (read-block-comment s (read-byte)))
(read-block-comment (read-byte)))) (read-block-comment s (read-byte))))
;; (define (read-hex c) ;; (define (read-hex c)
;; (if (eq? c 10) c ;; (if (eq? c 10) c
@ -116,7 +122,10 @@
(begin (unread-byte c) (lookup w a)))) (begin (unread-byte c) (lookup w a))))
((eq? c 35) (cond ((eq? c 35) (cond
((eq? (peek-byte) 33) (begin (read-byte) ((eq? (peek-byte) 33) (begin (read-byte)
(read-block-comment (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))) (read-word (read-byte) w a)))
((eq? (peek-byte) 40) (read-byte) (list->vector (read-list a))) ((eq? (peek-byte) 40) (read-byte) (list->vector (read-list a)))
((eq? (peek-byte) 92) (read-byte) (read-character)) ((eq? (peek-byte) 92) (read-byte) (read-character))

10
reader.c
View file

@ -37,10 +37,10 @@ unread_char (SCM c)
} }
int int
read_block_comment (int c) read_block_comment (int s, int c)
{ {
if (c == '!' && peekchar () == '#') return getchar (); if (c == s && peekchar () == '#') return getchar ();
return read_block_comment (getchar ()); return read_block_comment (s, getchar ());
} }
int int
@ -95,7 +95,7 @@ read_word (int c, SCM w, SCM a)
if (c == '#' && peekchar () == '\\') {getchar (); return read_character ();} if (c == '#' && peekchar () == '\\') {getchar (); return read_character ();}
if (c == '#' && w == cell_nil && peekchar () == '(') {getchar (); return list_to_vector (read_list (a));} if (c == '#' && w == cell_nil && peekchar () == '(') {getchar (); return list_to_vector (read_list (a));}
if (c == '#' && peekchar () == ';') {getchar (); read_word (getchar (), w, a); return read_word (getchar (), w, a);} if (c == '#' && peekchar () == ';') {getchar (); read_word (getchar (), w, a); return read_word (getchar (), w, a);}
if (c == '#' && peekchar () == '!') {getchar (); read_block_comment (getchar ()); return read_word (getchar (), w, a);} if (c == '#' && (peekchar () == '!' || peekchar () == '|')) {c = getchar (); read_block_comment (c, getchar ()); return read_word (getchar (), w, a);}
#endif //READER #endif //READER
return read_word (getchar (), append2 (w, cons (make_char (c), cell_nil)), a); return read_word (getchar (), append2 (w, cons (make_char (c), cell_nil)), a);
} }
@ -183,7 +183,7 @@ eat_whitespace (int c)
while (c == ' ' || c == '\t' || c == '\n' || c == '\f') c = getchar (); while (c == ' ' || c == '\t' || c == '\n' || c == '\f') c = getchar ();
if (c == ';') return eat_whitespace (read_line_comment (c)); if (c == ';') return eat_whitespace (read_line_comment (c));
#if READER #if READER
if (c == '#' && peekchar () == '!') {getchar (); read_block_comment (getchar ()); return eat_whitespace (getchar ());} if (c == '#' && (peekchar () == '!' || peek_char () == '|')) {c=getchar (); read_block_comment (c, getchar ()); return eat_whitespace (getchar ());}
#endif #endif
return c; return c;
} }

3
tests/read.test
View file

@ -32,6 +32,9 @@ cons
#! #!
barf barf
!# !#
#|
burp
|#
#;(bla) (display "must see!\n") #;(bla) (display "must see!\n")
(display `(display ,display)) (newline) (display `(display ,display)) (newline)
(display `(display ,@'(string port))) (newline) (display `(display ,@'(string port))) (newline)