diff options
author | Mark H Weaver <mhw@netris.org> | 2014-01-12 07:55:22 -0500 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2014-01-14 20:23:21 -0500 |
commit | dc59631d3094ad39bba5e40d5c36200fb99023f9 (patch) | |
tree | 8448ce41b34541c89edecdee8e841fde77a2b5eb /libguile/read.c | |
parent | b306fae0abe38aac6fede98727a47f57a4ba992f (diff) | |
download | guile-dc59631d3094ad39bba5e40d5c36200fb99023f9.tar.gz |
read: Support R7RS |...| symbol notation.
* libguile/private-options.h (SCM_R7RS_SYMBOLS_P): New macro.
(SCM_N_READ_OPTIONS): Increment.
* libguile/read.c (scm_read_opts): Add entry for 'r7rs-symbols'.
(t_read_opts): Add field for 'r7rs_symbols_p'.
(scm_read_string_like_syntax): New function based on earlier
'scm_read_string' that handles either string literals or R7RS quoted
symbols (delimited by vertical bars), depending on the value of 'chr'.
(scm_read_string): Reimplement based on 'scm_read_string_like_syntax'.
(scm_read_r7rs_symbol): New static function.
* doc/ref/api-data.texi (Symbol Read Syntax): Briefly describe the R7RS
symbol syntax, mention the 'r7rs-symbols' read option, and give some
examples.
* doc/ref/api-evaluation.texi (Scheme Read): Mention the 'r7rs-symbols'
read option.
* test-suite/tests/reader.test ("reading"): Add test.
Diffstat (limited to 'libguile/read.c')
-rw-r--r-- | libguile/read.c | 40 |
1 files changed, 34 insertions, 6 deletions
diff --git a/libguile/read.c b/libguile/read.c index e862c206e..f7edc4f8a 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -88,6 +88,8 @@ scm_t_option scm_read_opts[] = "In strings, consume leading whitespace after an escaped end-of-line."}, { SCM_OPTION_BOOLEAN, "curly-infix", 0, "Support SRFI-105 curly infix expressions."}, + { SCM_OPTION_BOOLEAN, "r7rs-symbols", 0, + "Support R7RS |...| symbol notation."}, { 0, }, }; @@ -113,6 +115,7 @@ struct t_read_opts unsigned int hungry_eol_escapes_p : 1; unsigned int curly_infix_p : 1; unsigned int neoteric_p : 1; + unsigned int r7rs_symbols_p : 1; }; typedef struct t_read_opts scm_t_read_opts; @@ -588,8 +591,11 @@ skip_intraline_whitespace (SCM port) scm_ungetc (c, port); } +/* Read either a double-quoted string or an R7RS-style symbol delimited + by vertical lines, depending on the value of 'chr' ('"' or '|'). + Regardless, the result is always returned as a string. */ static SCM -scm_read_string (int chr, SCM port, scm_t_read_opts *opts) +scm_read_string_like_syntax (int chr, SCM port, scm_t_read_opts *opts) #define FUNC_NAME "scm_lreadr" { /* For strings smaller than C_STR, this function creates only one Scheme @@ -603,13 +609,16 @@ scm_read_string (int chr, SCM port, scm_t_read_opts *opts) long line = SCM_LINUM (port); int column = SCM_COL (port) - 1; - while ('"' != (c = scm_getc (port))) + while (chr != (c = scm_getc (port))) { if (c == EOF) { str_eof: scm_i_input_error (FUNC_NAME, port, - "end of file in string constant", SCM_EOL); + (chr == '|' + ? "end of file in symbol" + : "end of file in string constant"), + SCM_EOL); } if (c_str_len + 1 >= READER_STRING_BUFFER_SIZE) @@ -624,7 +633,6 @@ scm_read_string (int chr, SCM port, scm_t_read_opts *opts) { case EOF: goto str_eof; - case '"': case '|': case '\\': break; @@ -657,7 +665,7 @@ scm_read_string (int chr, SCM port, scm_t_read_opts *opts) c = '\010'; break; case 'x': - if (opts->r6rs_escapes_p) + if (opts->r6rs_escapes_p || chr == '|') SCM_READ_HEX_ESCAPE (10, ';'); else SCM_READ_HEX_ESCAPE (2, '\0'); @@ -675,6 +683,8 @@ scm_read_string (int chr, SCM port, scm_t_read_opts *opts) break; } default: + if (c == chr) + break; bad_escaped: scm_i_input_error (FUNC_NAME, port, "illegal character in escape sequence: ~S", @@ -700,6 +710,17 @@ scm_read_string (int chr, SCM port, scm_t_read_opts *opts) } #undef FUNC_NAME +static SCM +scm_read_string (int chr, SCM port, scm_t_read_opts *opts) +{ + return scm_read_string_like_syntax (chr, port, opts); +} + +static SCM +scm_read_r7rs_symbol (int chr, SCM port, scm_t_read_opts *opts) +{ + return scm_string_to_symbol (scm_read_string_like_syntax (chr, port, opts)); +} static SCM scm_read_number (scm_t_wchar chr, SCM port, scm_t_read_opts *opts) @@ -1788,6 +1809,11 @@ read_inner_expression (SCM port, scm_t_read_opts *opts) return (scm_read_sexp (chr, port, opts)); case '"': return (scm_read_string (chr, port, opts)); + case '|': + if (opts->r7rs_symbols_p) + return scm_read_r7rs_symbol (chr, port, opts); + else + return scm_read_mixed_case_symbol (chr, port, opts); case '\'': case '`': case ',': @@ -2204,9 +2230,10 @@ SCM_SYMBOL (sym_port_read_options, "port-read-options"); #define READ_OPTION_SQUARE_BRACKETS_P 10 #define READ_OPTION_HUNGRY_EOL_ESCAPES_P 12 #define READ_OPTION_CURLY_INFIX_P 14 +#define READ_OPTION_R7RS_SYMBOLS_P 16 /* The total width in bits of the per-port overrides */ -#define READ_OPTIONS_NUM_BITS 16 +#define READ_OPTIONS_NUM_BITS 18 #define READ_OPTIONS_INHERIT_ALL ((1UL << READ_OPTIONS_NUM_BITS) - 1) #define READ_OPTIONS_MAX_VALUE READ_OPTIONS_INHERIT_ALL @@ -2304,6 +2331,7 @@ init_read_options (SCM port, scm_t_read_opts *opts) RESOLVE_BOOLEAN_OPTION (SQUARE_BRACKETS_P, square_brackets_p); RESOLVE_BOOLEAN_OPTION (HUNGRY_EOL_ESCAPES_P, hungry_eol_escapes_p); RESOLVE_BOOLEAN_OPTION (CURLY_INFIX_P, curly_infix_p); + RESOLVE_BOOLEAN_OPTION (R7RS_SYMBOLS_P, r7rs_symbols_p); #undef RESOLVE_BOOLEAN_OPTION |