summaryrefslogtreecommitdiff
path: root/libguile/print.c
diff options
context:
space:
mode:
authorMichael Gran <spk121@yahoo.com>2009-08-21 08:57:35 -0700
committerMichael Gran <spk121@yahoo.com>2009-08-21 08:57:35 -0700
commite23106d53eb03d7cb4962282396269176ea7482e (patch)
treed7736a8f7f16af0c73365f688f75561aac81c5eb /libguile/print.c
parent90305ce9e429f0381ff79427e71287fdafd4d201 (diff)
downloadguile-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.c59
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);
{