summaryrefslogtreecommitdiff
path: root/libguile/read.c
diff options
context:
space:
mode:
authorMichael Gran <spk121@yahoo.com>2009-08-08 02:35:00 -0700
committerMichael Gran <spk121@yahoo.com>2009-08-08 02:35:00 -0700
commit9c44cd4559a5d04ba70bbd9ff47f41bfdfebd09d (patch)
treeea93002217c56ad32f123836dab5d6fd1ef02930 /libguile/read.c
parenta876e7dcea78e770bedba40017fbb225cf88bff5 (diff)
downloadguile-9c44cd4559a5d04ba70bbd9ff47f41bfdfebd09d.tar.gz
Add Unicode strings and symbols
This adds full Unicode strings as a datatype, and it adds some minimal functionality. The terminal and port encoding is assumed to be ISO-8859-1. Non-ISO-8859-1 characters are written or input as string character escapes. The string character escapes now have 3 forms: \xXX \uXXXX and \UXXXXXX, for unprintable characters that have 2, 4 or 6 hex digits. The process for writing to strings has been modified. There is now a function scm_i_string_start_writing that does the copy-on-write conversion if necessary. To compile strings that may be wide, the VM storage of strings and string-likes has changed. Most string-using functions have not yet been updated and may break when used with wide strings. * module/language/assembly/compile-bytecode.scm (write-bytecode): use variable width string bytecode format * module/language/assembly.scm (byte-length): use variable width bytecode format * libguile/vm-i-loader.c (load-string, load-symbol): (load-keyword, define): use variable-width bytecode format * libguile/vm-engine.h (FETCH_WIDTH): new macro * libguile/strings.h: new declarations * libguile/strings.c (make_wide_stringbuf): new function (widen_stringbuf): new function (scm_i_make_wide_string): new function (scm_i_is_narrow_string): new function (scm_i_string_wide_chars): new function (scm_i_string_start_writing): new function (scm_i_string_ref): new function (scm_i_string_set_x): new function (scm_i_is_narrow_symbol): new function (scm_i_symbol_wide_chars, scm_i_symbol_ref): new function (scm_string_width): new function (unistring_escapes_to_guile_escapes): new function (scm_to_stringn): new function (scm_i_stringbuf_free): modify for wide strings (scm_i_substring_copy): modify for wide strings (scm_i_string_chars, scm_string_append): modify for wide strings (scm_i_make_symbol, scm_to_locale_stringn): modify for wide strings (scm_string_dump, scm_symbol_dump, scm_to_locale_stringbuf): (scm_string, scm_i_deprecated_string_chars): modify for wide strings (scm_from_locale_string, scm_from_locale_stringn): add null test * libguile/srfi-13.c: add calls for scm_i_string_start_writing for each call of scm_i_string_stop_writing (scm_string_for_each): modify for wide strings * libguile/socket.c: add calls for scm_i_string_start_writing for each call of scm_i_string_stop_writing * libguile/rw.c: add calls for scm_i_string_start_writing for each call of scm_i_string_stop_writing * libguile/read.c (scm_read_string): allow reading of wide strings * libguile/print.h: add declaration for scm_charprint * libguile/print.c (iprin1): print wide strings and add new string escapes (scm_charprint): new function * libguile/ports.h: new declarations for scm_lfwrite_substr and scm_lfwrite_str * libguile/ports.c (update_port_lf): new function (scm_lfwrite): use update_port_lf (scm_lfwrite_substr): new function (scm_lfwrite_str): new function * test-suite/tests/asm-to-bytecode.test ("compiler"): add string width byte to sting-like asm tests
Diffstat (limited to 'libguile/read.c')
-rw-r--r--libguile/read.c233
1 files changed, 145 insertions, 88 deletions
diff --git a/libguile/read.c b/libguile/read.c
index 2140fed25..577a73e58 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -387,110 +387,167 @@ scm_read_string (int chr, SCM port)
object (the string returned). */
SCM str = SCM_BOOL_F;
- char c_str[READER_STRING_BUFFER_SIZE];
unsigned c_str_len = 0;
- int c;
+ scm_t_wchar c;
+ str = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL);
while ('"' != (c = scm_getc (port)))
{
if (c == EOF)
- str_eof: scm_i_input_error (FUNC_NAME, port,
- "end of file in string constant",
- SCM_EOL);
-
- if (c_str_len + 1 >= sizeof (c_str))
- {
- /* Flush the C buffer onto a Scheme string. */
- SCM addy;
+ {
+ str_eof:
+ scm_i_input_error (FUNC_NAME, port,
+ "end of file in string constant", SCM_EOL);
+ }
- if (str == SCM_BOOL_F)
- str = scm_c_make_string (0, SCM_MAKE_CHAR ('X'));
+ if (c_str_len + 1 >= scm_i_string_length (str))
+ {
+ SCM addy = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL);
- addy = scm_from_locale_stringn (c_str, c_str_len);
- str = scm_string_append_shared (scm_list_2 (str, addy));
-
- c_str_len = 0;
- }
+ str = scm_string_append (scm_list_2 (str, addy));
+ }
if (c == '\\')
- switch (c = scm_getc (port))
- {
- case EOF:
- goto str_eof;
- case '"':
- case '\\':
- break;
+ {
+ switch (c = scm_getc (port))
+ {
+ case EOF:
+ goto str_eof;
+ case '"':
+ case '\\':
+ break;
#if SCM_ENABLE_ELISP
- case '(':
- case ')':
- if (SCM_ESCAPED_PARENS_P)
- break;
- goto bad_escaped;
+ case '(':
+ case ')':
+ if (SCM_ESCAPED_PARENS_P)
+ break;
+ goto bad_escaped;
#endif
- case '\n':
- continue;
- case '0':
- c = '\0';
- break;
- case 'f':
- c = '\f';
- break;
- case 'n':
- c = '\n';
- break;
- case 'r':
- c = '\r';
- break;
- case 't':
- c = '\t';
- break;
- case 'a':
- c = '\007';
- break;
- case 'v':
- c = '\v';
- break;
- case 'x':
- {
- int a, b;
- a = scm_getc (port);
- if (a == EOF) goto str_eof;
- b = scm_getc (port);
- if (b == 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 goto bad_escaped;
- if ('0' <= b && b <= '9') b -= '0';
- else if ('A' <= b && b <= 'F') b = b - 'A' + 10;
- else if ('a' <= b && b <= 'f') b = b - 'a' + 10;
- else goto bad_escaped;
- c = a * 16 + b;
- break;
- }
- default:
- bad_escaped:
- scm_i_input_error (FUNC_NAME, port,
- "illegal character in escape sequence: ~S",
- scm_list_1 (SCM_MAKE_CHAR (c)));
- }
- c_str[c_str_len++] = c;
+ case '\n':
+ continue;
+ case '0':
+ c = '\0';
+ break;
+ case 'f':
+ c = '\f';
+ break;
+ case 'n':
+ c = '\n';
+ break;
+ case 'r':
+ c = '\r';
+ break;
+ case 't':
+ c = '\t';
+ break;
+ case 'a':
+ c = '\007';
+ break;
+ case 'v':
+ c = '\v';
+ break;
+ case 'x':
+ {
+ scm_t_wchar a, b;
+ a = scm_getc (port);
+ if (a == EOF)
+ goto str_eof;
+ b = scm_getc (port);
+ if (b == 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;
+ }
+ if ('0' <= b && b <= '9')
+ b -= '0';
+ else if ('A' <= b && b <= 'F')
+ b = b - 'A' + 10;
+ else if ('a' <= b && b <= 'f')
+ b = b - 'a' + 10;
+ else
+ {
+ c = b;
+ goto bad_escaped;
+ }
+ c = a * 16 + b;
+ break;
+ }
+ case 'u':
+ {
+ scm_t_wchar a;
+ int i;
+ c = 0;
+ for (i = 0; i < 4; i++)
+ {
+ 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;
+ }
+ break;
+ }
+ case 'U':
+ {
+ scm_t_wchar a;
+ int i;
+ c = 0;
+ for (i = 0; i < 6; i++)
+ {
+ 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;
+ }
+ break;
+ }
+ default:
+ bad_escaped:
+ scm_i_input_error (FUNC_NAME, port,
+ "illegal character in escape sequence: ~S",
+ scm_list_1 (SCM_MAKE_CHAR (c)));
+ }
+ }
+ str = scm_i_string_start_writing (str);
+ scm_i_string_set_x (str, c_str_len++, c);
+ scm_i_string_stop_writing ();
}
if (c_str_len > 0)
{
- SCM addy;
-
- addy = scm_from_locale_stringn (c_str, c_str_len);
- if (str == SCM_BOOL_F)
- str = addy;
- else
- str = scm_string_append_shared (scm_list_2 (str, addy));
+ return scm_i_substring_copy (str, 0, c_str_len);
}
- else
- str = (str == SCM_BOOL_F) ? scm_nullstr : str;
-
- return str;
+
+ return scm_nullstr;
}
#undef FUNC_NAME