summaryrefslogtreecommitdiff
path: root/libguile/read.c
diff options
context:
space:
mode:
authorMichael Gran <spk121@yahoo.com>2010-01-12 21:02:41 -0800
committerMichael Gran <spk121@yahoo.com>2010-01-12 21:02:41 -0800
commitdea901d66e46041f96d3d3a0f95bf0ab209387c9 (patch)
treef46c70881aac3180a26b2b716725794e3fc14269 /libguile/read.c
parent8470b3f45b48bf627642e8f41938492be4eacf2c (diff)
downloadguile-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.c88
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)