diff options
author | Michael Gran <spk121@yahoo.com> | 2009-08-08 02:35:00 -0700 |
---|---|---|
committer | Michael Gran <spk121@yahoo.com> | 2009-08-08 02:35:00 -0700 |
commit | 9c44cd4559a5d04ba70bbd9ff47f41bfdfebd09d (patch) | |
tree | ea93002217c56ad32f123836dab5d6fd1ef02930 /libguile/read.c | |
parent | a876e7dcea78e770bedba40017fbb225cf88bff5 (diff) | |
download | guile-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.c | 233 |
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 |