diff options
author | Michael Gran <spk121@yahoo.com> | 2010-01-12 21:02:41 -0800 |
---|---|---|
committer | Michael Gran <spk121@yahoo.com> | 2010-01-12 21:02:41 -0800 |
commit | dea901d66e46041f96d3d3a0f95bf0ab209387c9 (patch) | |
tree | f46c70881aac3180a26b2b716725794e3fc14269 /libguile/read.c | |
parent | 8470b3f45b48bf627642e8f41938492be4eacf2c (diff) | |
download | guile-dea901d66e46041f96d3d3a0f95bf0ab209387c9.tar.gz |
Reader option for R6RS hex escapes
This adds a reader option 'r6rs-hex-escapes that modifies the
behavior of numeric escapes in characters and strings. When enabled,
variable-length character hex escapes (#\xNNN) are allowed and become
the default output format for numerically-escaped characters. Also,
string hex escapes switch to a semicolon terminated hex escape (\xNNNN;).
* libguile/print.c (PRINT_CHAR_ESCAPE): new macro
(iprin1): use new macro PRINT_CHAR_ESCAPE
* libguile/private-options.h (SCM_R6RS_ESCAPES_P): new #define
* libguile/read.c (scm_read_opts): add new option r6rs-hex-escapes
(SCM_READ_HEX_ESCAPE): modify to take a terminator parameter
(scm_read_string): parse R6RS hex string escapes
(scm_read_character): parse R6RS hex character escapes
* test-suite/tests/chars.test (with-read-options): new procedure
(R6RS hex escapes): new tests
* test-suite/tests/strings.test (with-read-options): new procedure
(R6RS hex escapes): new tests
Diffstat (limited to 'libguile/read.c')
-rw-r--r-- | libguile/read.c | 88 |
1 files changed, 59 insertions, 29 deletions
diff --git a/libguile/read.c b/libguile/read.c index 011684b3d..9e66cce80 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -76,6 +76,8 @@ scm_t_option scm_read_opts[] = { { SCM_OPTION_BOOLEAN, "elisp-strings", 0, "Support `\\(' and `\\)' in strings."}, #endif + { SCM_OPTION_BOOLEAN, "r6rs-hex-escapes", 0, + "Use R6RS variable-length character and string hex escapes."}, { 0, }, }; @@ -412,32 +414,37 @@ scm_read_sexp (scm_t_wchar chr, SCM port) /* Read a hexadecimal number NDIGITS in length. Put its value into the variable - C. */ -#define SCM_READ_HEX_ESCAPE(ndigits) \ - do \ - { \ - scm_t_wchar a; \ - size_t i = 0; \ - c = 0; \ - while (i < ndigits) \ - { \ - a = scm_getc (port); \ - if (a == EOF) \ - goto str_eof; \ - if ('0' <= a && a <= '9') \ - a -= '0'; \ - else if ('A' <= a && a <= 'F') \ - a = a - 'A' + 10; \ - else if ('a' <= a && a <= 'f') \ - a = a - 'a' + 10; \ - else \ - { \ - c = a; \ - goto bad_escaped; \ - } \ - c = c * 16 + a; \ - i ++; \ - } \ + C. If TERMINATOR is non-null, terminate early if the TERMINATOR character is + found. */ +#define SCM_READ_HEX_ESCAPE(ndigits, terminator) \ + do \ + { \ + scm_t_wchar a; \ + size_t i = 0; \ + c = 0; \ + while (i < ndigits) \ + { \ + a = scm_getc (port); \ + if (a == EOF) \ + goto str_eof; \ + if (terminator \ + && (a == (scm_t_wchar) terminator) \ + && (i > 0)) \ + break; \ + if ('0' <= a && a <= '9') \ + a -= '0'; \ + else if ('A' <= a && a <= 'F') \ + a = a - 'A' + 10; \ + else if ('a' <= a && a <= 'f') \ + a = a - 'a' + 10; \ + else \ + { \ + c = a; \ + goto bad_escaped; \ + } \ + c = c * 16 + a; \ + i ++; \ + } \ } while (0) static SCM @@ -511,13 +518,16 @@ scm_read_string (int chr, SCM port) c = '\010'; break; case 'x': - SCM_READ_HEX_ESCAPE (2); + if (SCM_R6RS_ESCAPES_P) + SCM_READ_HEX_ESCAPE (10, ';'); + else + SCM_READ_HEX_ESCAPE (2, '\0'); break; case 'u': - SCM_READ_HEX_ESCAPE (4); + SCM_READ_HEX_ESCAPE (4, '\0'); break; case 'U': - SCM_READ_HEX_ESCAPE (6); + SCM_READ_HEX_ESCAPE (6, '\0'); break; default: bad_escaped: @@ -828,6 +838,26 @@ scm_read_character (scm_t_wchar chr, SCM port) } } + if (cp == 'x' && (charname_len > 1) && SCM_R6RS_ESCAPES_P) + { + SCM p; + scm_t_wchar chr; + + /* Convert from hex, skipping the initial 'x' character in CHARNAME */ + p = scm_string_to_number (scm_c_substring (charname, 1, charname_len), + scm_from_uint (16)); + if (SCM_I_INUMP (p)) + { + scm_t_wchar c = SCM_I_INUM (p); + if (SCM_IS_UNICODE_CHAR (c)) + return SCM_MAKE_CHAR (c); + else + scm_i_input_error (FUNC_NAME, port, + "out-of-range hex character escape: ~a", + scm_list_1 (charname)); + } + } + /* The names of characters should never have non-Latin1 characters. */ if (scm_i_is_narrow_string (charname) |