Merge commit '54cded99dc5db94b1df0dc417161ebef7c60d874'

[bpt/guile.git] / libguile / symbols.c

diff --git a/libguile/symbols.c b/libguile/symbols.c
index 498e46c..f93833b 100644 (file)
--- a/libguile/symbols.c
+++ b/libguile/symbols.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2003, 2004,
- *   2006, 2009, 2011 Free Software Foundation, Inc.
+ *   2006, 2009, 2011, 2013 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -23,6 +23,8 @@
 #  include <config.h>
 #endif
 
+#include <unistr.h>
+
 #include "libguile/_scm.h"
 #include "libguile/chars.h"
 #include "libguile/eval.h"
@@ -144,6 +146,73 @@ lookup_interned_latin1_symbol (const char *str, size_t len,
                                 &data, SCM_BOOL_F);
 }
 
+struct utf8_lookup_data
+{
+  const char *str;
+  size_t len;
+  unsigned long string_hash;
+};
+
+static int
+utf8_string_equals_wide_string (const scm_t_uint8 *narrow, size_t nlen,
+                                const scm_t_wchar *wide, size_t wlen)
+{
+  size_t byte_idx = 0, char_idx = 0;
+  
+  while (byte_idx < nlen && char_idx < wlen)
+    {
+      ucs4_t c;
+      int nbytes;
+
+      nbytes = u8_mbtouc (&c, narrow + byte_idx, nlen - byte_idx);
+      if (nbytes == 0)
+        break;
+      else if (c == 0xfffd)
+        /* Bad UTF-8.  */
+        return 0;
+      else if (c != wide[char_idx])
+        return 0;
+
+      byte_idx += nbytes;
+      char_idx++;
+    }
+
+  return byte_idx == nlen && char_idx == wlen;
+}
+
+static int
+utf8_lookup_predicate_fn (SCM sym, void *closure)
+{
+  struct utf8_lookup_data *data = closure;
+
+  if (scm_i_symbol_hash (sym) != data->string_hash)
+    return 0;
+  
+  if (scm_i_is_narrow_symbol (sym))
+    return (scm_i_symbol_length (sym) == data->len
+            && strncmp (scm_i_symbol_chars (sym), data->str, data->len) == 0);
+  else
+    return utf8_string_equals_wide_string ((const scm_t_uint8 *) data->str,
+                                           data->len,
+                                           scm_i_symbol_wide_chars (sym),
+                                           scm_i_symbol_length (sym));
+}
+
+static SCM
+lookup_interned_utf8_symbol (const char *str, size_t len,
+                             unsigned long raw_hash)
+{
+  struct utf8_lookup_data data;
+
+  data.str = str;
+  data.len = len;
+  data.string_hash = raw_hash;
+  
+  return scm_c_weak_set_lookup (symbols, raw_hash,
+                                utf8_lookup_predicate_fn,
+                                &data, SCM_BOOL_F);
+}
+
 static int
 symbol_lookup_predicate_fn (SCM sym, void *closure)
 {
@@ -353,7 +422,7 @@ SCM_DEFINE (scm_symbol_hash, "symbol-hash", 1, 0, 0,
 
 SCM_DEFINE (scm_symbol_fref, "symbol-fref", 1, 0, 0, 
            (SCM s),
-           "Return the contents of @var{symbol}'s @dfn{function slot}.")
+           "Return the contents of the symbol @var{s}'s @dfn{function slot}.")
 #define FUNC_NAME s_scm_symbol_fref
 {
   SCM_VALIDATE_SYMBOL (1, s);
@@ -364,7 +433,8 @@ SCM_DEFINE (scm_symbol_fref, "symbol-fref", 1, 0, 0,
 
 SCM_DEFINE (scm_symbol_pref, "symbol-pref", 1, 0, 0, 
            (SCM s),
-           "Return the @dfn{property list} currently associated with @var{symbol}.")
+           "Return the @dfn{property list} currently associated with the\n"
+           "symbol @var{s}.")
 #define FUNC_NAME s_scm_symbol_pref
 {
   SCM_VALIDATE_SYMBOL (1, s);
@@ -375,7 +445,7 @@ SCM_DEFINE (scm_symbol_pref, "symbol-pref", 1, 0, 0,
 
 SCM_DEFINE (scm_symbol_fset_x, "symbol-fset!", 2, 0, 0, 
            (SCM s, SCM val),
-           "Change the binding of @var{symbol}'s function slot.")
+           "Change the binding of the symbol @var{s}'s function slot.")
 #define FUNC_NAME s_scm_symbol_fset_x
 {
   SCM_VALIDATE_SYMBOL (1, s);
@@ -387,7 +457,7 @@ SCM_DEFINE (scm_symbol_fset_x, "symbol-fset!", 2, 0, 0,
 
 SCM_DEFINE (scm_symbol_pset_x, "symbol-pset!", 2, 0, 0,
            (SCM s, SCM val),
-           "Change the binding of @var{symbol}'s property slot.")
+           "Change the binding of the symbol @var{s}'s property slot.")
 #define FUNC_NAME s_scm_symbol_pset_x
 {
   SCM_VALIDATE_SYMBOL (1, s);
@@ -459,8 +529,21 @@ scm_from_utf8_symbol (const char *sym)
 SCM
 scm_from_utf8_symboln (const char *sym, size_t len)
 {
-  SCM str = scm_from_utf8_stringn (sym, len);
-  return scm_i_str2symbol (str);
+  unsigned long hash;
+  SCM ret;
+
+  if (len == (size_t) -1)
+    len = strlen (sym);
+  hash = scm_i_utf8_string_hash (sym, len);
+
+  ret = lookup_interned_utf8_symbol (sym, len, hash);
+  if (scm_is_false (ret))
+    {
+      SCM str = scm_from_utf8_stringn (sym, len);
+      ret = scm_i_str2symbol (str);
+    }
+
+  return ret;
 }
 
 void