diff options
author | Michael Gran <spk121@yahoo.com> | 2009-08-21 08:57:35 -0700 |
---|---|---|
committer | Michael Gran <spk121@yahoo.com> | 2009-08-21 08:57:35 -0700 |
commit | e23106d53eb03d7cb4962282396269176ea7482e (patch) | |
tree | d7736a8f7f16af0c73365f688f75561aac81c5eb /libguile/print.c | |
parent | 90305ce9e429f0381ff79427e71287fdafd4d201 (diff) | |
download | guile-e23106d53eb03d7cb4962282396269176ea7482e.tar.gz |
Add initial support for wide symbols
* libguile/hash.c (scm_i_string_hash): new function
(scm_hasher): don't unpack string: use scm_i_string_hash
* libguile/hash.h: new declaration for scm_i_string_hash
* libguile/print.c (quote_keywordish_symbol): use symbol accessors
(scm_i_print_symbol_name): new function
(scm_print_symbol_name): call scm_i_print_symbol_name
(iprin1): use scm_i_print_symbol_name to print symbols
* libguile/print.h: new declaration for scm_i_print_symbol_name
* libguile/symbols.c (lookup_interned_symbol): now takes scheme string
instead of c string; callers changed
(lookup_interned_symbol): add wide symbol support
(scm_i_c_mem2symbol): removed
(scm_i_mem2symbol): removed and replaced with scm_i_str2symbol
(scm_i_str2symbol): new function
(scm_i_mem2uninterned_symbol): removed and replaced with
scm_i_str2uninterned_symbol
(scm_i_str2uninterned_symbol): new function
(scm_make_symbol, scm_string_to_symbol, scm_from_locale_symbol)
(scm_from_locale_symboln): use scm_i_str2symbol
* test-suite/tests/symbols.test: new tests
Diffstat (limited to 'libguile/print.c')
-rw-r--r-- | libguile/print.c | 59 |
1 files changed, 33 insertions, 26 deletions
diff --git a/libguile/print.c b/libguile/print.c index 74f7d8db6..07bff47fd 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -295,13 +295,12 @@ print_circref (SCM port, scm_print_state *pstate, SCM ref) /* Print the name of a symbol. */ static int -quote_keywordish_symbol (const char *str, size_t len) +quote_keywordish_symbol (SCM symbol) { SCM option; - /* LEN is guaranteed to be > 0. - */ - if (str[0] != ':' && str[len-1] != ':') + if (scm_i_symbol_ref (symbol, 0) != ':' + && scm_i_symbol_ref (symbol, scm_i_symbol_length (symbol) - 1) != ':') return 0; option = SCM_PRINT_KEYWORD_STYLE; @@ -313,7 +312,7 @@ quote_keywordish_symbol (const char *str, size_t len) } void -scm_print_symbol_name (const char *str, size_t len, SCM port) +scm_i_print_symbol_name (SCM str, SCM port) { /* This points to the first character that has not yet been written to the * port. */ @@ -334,18 +333,20 @@ scm_print_symbol_name (const char *str, size_t len, SCM port) * simpler and faster. */ int maybe_weird = 0; size_t mw_pos = 0; + size_t len = scm_i_symbol_length (str); + scm_t_wchar str0 = scm_i_symbol_ref (str, 0); - if (len == 0 || str[0] == '\'' || str[0] == '`' || str[0] == ',' - || quote_keywordish_symbol (str, len) - || (str[0] == '.' && len == 1) - || scm_is_true (scm_c_locale_stringn_to_number (str, len, 10))) + if (len == 0 || str0 == '\'' || str0 == '`' || str0 == ',' + || quote_keywordish_symbol (str) + || (str0 == '.' && len == 1) + || scm_is_true (scm_i_string_to_number (scm_symbol_to_string (str), 10))) { scm_lfwrite ("#{", 2, port); weird = 1; } for (end = pos; end < len; ++end) - switch (str[end]) + switch (scm_i_symbol_ref (str, end)) { #ifdef BRACKETS_AS_PARENS case '[': @@ -370,11 +371,11 @@ scm_print_symbol_name (const char *str, size_t len, SCM port) weird = 1; } if (pos < end) - scm_lfwrite (str + pos, end - pos, port); + scm_lfwrite_substr (scm_symbol_to_string (str), pos, end, port); { char buf[2]; buf[0] = '\\'; - buf[1] = str[end]; + buf[1] = (char) (unsigned char) scm_i_symbol_ref (str, end); scm_lfwrite (buf, 2, port); } pos = end + 1; @@ -392,11 +393,18 @@ scm_print_symbol_name (const char *str, size_t len, SCM port) break; } if (pos < end) - scm_lfwrite (str + pos, end - pos, port); + scm_lfwrite_substr (scm_symbol_to_string (str), pos, end, port); if (weird) scm_lfwrite ("}#", 2, port); } +void +scm_print_symbol_name (const char *str, size_t len, SCM port) +{ + SCM symbol = scm_from_locale_symboln (str, len); + return scm_i_print_symbol_name (symbol, port); +} + /* Print generally. Handles both write and display according to PSTATE. */ SCM_GPROC(s_write, "write", 1, 1, 0, scm_write, g_write); @@ -665,16 +673,13 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate) case scm_tc7_symbol: if (scm_i_symbol_is_interned (exp)) { - scm_print_symbol_name (scm_i_symbol_chars (exp), - scm_i_symbol_length (exp), port); + scm_i_print_symbol_name (exp, port); scm_remember_upto_here_1 (exp); } else { scm_puts ("#<uninterned-symbol ", port); - scm_print_symbol_name (scm_i_symbol_chars (exp), - scm_i_symbol_length (exp), - port); + scm_i_print_symbol_name (exp, port); scm_putc (' ', port); scm_uintprint (SCM_UNPACK (exp), 16, port); scm_putc ('>', port); @@ -726,14 +731,16 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate) EXIT_NESTED_DATA (pstate); break; case scm_tcs_subrs: - scm_puts (SCM_SUBR_GENERIC (exp) - ? "#<primitive-generic " - : "#<primitive-procedure ", - port); - scm_puts (scm_i_symbol_chars (SCM_SUBR_NAME (exp)), port); - scm_putc ('>', port); - break; - + { + SCM name = scm_symbol_to_string (SCM_SUBR_NAME (exp)); + scm_puts (SCM_SUBR_GENERIC (exp) + ? "#<primitive-generic " + : "#<primitive-procedure ", + port); + scm_lfwrite_str (name, port); + scm_putc ('>', port); + break; + } case scm_tc7_pws: scm_puts ("#<procedure-with-setter", port); { |