diff --git a/NEWS b/NEWS index 6f191f11..0495be8f 100644 --- a/NEWS +++ b/NEWS @@ -21,6 +21,7 @@ block-comments are all handled by the Scheme reader later. *** Cond now supports =>. *** Lambda* and define* are now supported. *** #;-comment is now supported. +*** Non-nested #| |#-comment is now supported. * Changes in 0.3 since 0.2 ** Core *** Number-based rather than pointer-based cells. diff --git a/module/mes/read-0.mes b/module/mes/read-0.mes index 1e77ddd7..31554846 100644 --- a/module/mes/read-0.mes +++ b/module/mes/read-0.mes @@ -74,15 +74,21 @@ ((eq? (peek-byte) 59) (begin (read-line-comment (read-byte)) (eat-whitespace))) ((eq? (peek-byte) 35) (begin (read-byte) - (if (eq? (peek-byte) 33) (begin (read-byte) - (read-block-comment (read-byte)) - (eat-whitespace)) - (unread-byte 35)))))) + (cond ((eq? (peek-byte) 33) + (read-byte) + (read-block-comment 33 (read-byte)) + (eat-whitespace)) + ((eq? (peek-byte) 124) + (read-byte) + (read-block-comment 124 (read-byte)) + (eat-whitespace)) + (#t (unread-byte 35))) +)))) - (define (read-block-comment c) - (if (eq? c 33) (if (eq? (peek-byte) 35) (read-byte) - (read-block-comment (read-byte))) - (read-block-comment (read-byte)))) + (define (read-block-comment s c) + (if (eq? c s) (if (eq? (peek-byte) 35) (read-byte) + (read-block-comment s (read-byte))) + (read-block-comment s (read-byte)))) ;; (define (read-hex c) ;; (if (eq? c 10) c @@ -116,8 +122,11 @@ (begin (unread-byte c) (lookup w a)))) ((eq? c 35) (cond ((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))) ((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)) diff --git a/reader.c b/reader.c index 6698061c..30cd8b08 100644 --- a/reader.c +++ b/reader.c @@ -37,10 +37,10 @@ unread_char (SCM c) } int -read_block_comment (int c) +read_block_comment (int s, int c) { - if (c == '!' && peekchar () == '#') return getchar (); - return read_block_comment (getchar ()); + if (c == s && peekchar () == '#') return getchar (); + return read_block_comment (s, getchar ()); } int @@ -95,7 +95,7 @@ read_word (int c, SCM w, SCM a) if (c == '#' && peekchar () == '\\') {getchar (); return read_character ();} 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_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 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 (); if (c == ';') return eat_whitespace (read_line_comment (c)); #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 return c; } diff --git a/tests/read.test b/tests/read.test index 3ebfe31d..5c9305a1 100755 --- a/tests/read.test +++ b/tests/read.test @@ -32,6 +32,9 @@ cons #! barf !# +#| +burp +|# #;(bla) (display "must see!\n") (display `(display ,display)) (newline) (display `(display ,@'(string port))) (newline)