diff options
author | Ludovic Courtès <ludo@gnu.org> | 2009-10-19 22:38:34 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2009-10-19 22:40:01 +0200 |
commit | 620c89651ae54f8f35c3d0926f8c2c36c3fdd174 (patch) | |
tree | 534c09fcdc42fdeba146ba5d32326c38b1b0f0d2 /libguile | |
parent | cbeb479c6e4da67ef37efa2548713fd6eadc71f3 (diff) | |
download | guile-620c89651ae54f8f35c3d0926f8c2c36c3fdd174.tar.gz |
Add support for R6RS/SRFI-30 nested block comments.
Suggested by Andreas Rottmann <a.rottmann@gmx.at>.
* libguile/read.c (flush_ws, scm_read_sharp): Add support for
R6RS/SRFI-30 block comments.
(scm_read_r6rs_block_comment): New function.
* test-suite/tests/reader.test (exception:unterminated-block-comment):
Adjust to match both block comment styles.
("reading")["R6RS/SRFI-30 block comment", "R6RS/SRFI-30 nested block
comment", "R6RS/SRFI-30 block comment syntax overridden"]: New tests.
("exceptions")["R6RS/SRFI-30 unterminated nested block comment"]: New
test.
* doc/ref/api-evaluation.texi (Block Comments): Mention SRFI-30/R6RS
block comments.
* doc/ref/srfi-modules.texi (SRFI-30): New node.
Diffstat (limited to 'libguile')
-rw-r--r-- | libguile/read.c | 68 |
1 files changed, 63 insertions, 5 deletions
diff --git a/libguile/read.c b/libguile/read.c index 07c8d7163..fc56418df 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -181,8 +181,10 @@ static SCM *scm_read_hash_procedures; || ((_chr) == 'd') || ((_chr) == 'l')) /* Read an SCSH block comment. */ -static inline SCM scm_read_scsh_block_comment (int chr, SCM port); -static SCM scm_read_commented_expression (int chr, SCM port); +static inline SCM scm_read_scsh_block_comment (scm_t_wchar, SCM); +static SCM scm_read_r6rs_block_comment (scm_t_wchar, SCM); +static SCM scm_read_commented_expression (scm_t_wchar, SCM); +static SCM scm_get_hash_procedure (int); /* Read from PORT until a delimiter (e.g., a whitespace) is read. Return zero if the whole token fits in BUF, non-zero otherwise. */ @@ -289,6 +291,13 @@ flush_ws (SCM port, const char *eoferr) case ';': scm_read_commented_expression (c, port); break; + case '|': + if (scm_is_false (scm_get_hash_procedure (c))) + { + scm_read_r6rs_block_comment (c, port); + break; + } + /* fall through */ default: scm_ungetc (c, port); return '#'; @@ -313,7 +322,6 @@ flush_ws (SCM port, const char *eoferr) static SCM scm_read_expression (SCM port); static SCM scm_read_sharp (int chr, SCM port); -static SCM scm_get_hash_procedure (int c); static SCM recsexpr (SCM obj, long line, int column, SCM filename); @@ -991,6 +999,45 @@ scm_read_scsh_block_comment (scm_t_wchar chr, SCM port) } static SCM +scm_read_r6rs_block_comment (scm_t_wchar chr, SCM port) +{ + /* Unlike SCSH-style block comments, SRFI-30/R6RS block comments may be + nested. So care must be taken. */ + int nesting_level = 1; + int opening_seen = 0, closing_seen = 0; + + while (nesting_level > 0) + { + int c = scm_getc (port); + + if (c == EOF) + scm_i_input_error (__FUNCTION__, port, + "unterminated `#| ... |#' comment", SCM_EOL); + + if (opening_seen) + { + if (c == '|') + nesting_level++; + opening_seen = 0; + } + else if (closing_seen) + { + if (c == '#') + nesting_level--; + closing_seen = 0; + } + else if (c == '|') + closing_seen = 1; + else if (c == '#') + opening_seen = 1; + else + opening_seen = closing_seen = 0; + } + + return SCM_UNSPECIFIED; +} + +static SCM scm_read_commented_expression (scm_t_wchar chr, SCM port) { scm_t_wchar c; @@ -1173,8 +1220,19 @@ scm_read_sharp (scm_t_wchar chr, SCM port) default: result = scm_read_sharp_extension (chr, port); if (scm_is_eq (result, SCM_UNSPECIFIED)) - scm_i_input_error (FUNC_NAME, port, "Unknown # object: ~S", - scm_list_1 (SCM_MAKE_CHAR (chr))); + { + /* To remain compatible with 1.8 and earlier, the following + characters have lower precedence than `read-hash-extend' + characters. */ + switch (chr) + { + case '|': + return scm_read_r6rs_block_comment (chr, port); + default: + scm_i_input_error (FUNC_NAME, port, "Unknown # object: ~S", + scm_list_1 (SCM_MAKE_CHAR (chr))); + } + } else return result; } |