From 5ce6c5667b3930be7a617c27f49c202fd2660eec Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 1 Jul 2008 14:08:07 +0200
Subject: [PATCH] Add `scm_c_symbol_length ()'.

---
 NEWS                  |    4 ++++
 doc/ref/api-data.texi |    5 +++++
 libguile/deprecated.c |    2 +-
 libguile/gc-mark.c    |    4 ++--
 libguile/print.c      |    6 +++---
 libguile/strings.c    |    6 +++++-
 libguile/strings.h    |    2 +-
 libguile/struct.c     |   16 ++++++++--------
 libguile/symbols.c    |    6 +++---
 9 files changed, 32 insertions(+), 19 deletions(-)

diff --git a/NEWS b/NEWS
index 16b1880..c2c8751 100644
--- a/NEWS
+++ b/NEWS
@@ -39,6 +39,10 @@ indicating length of the `scm_t_option' array.
 
 Changes in 1.8.6 (since 1.8.5)
 
+* New features (see the manual for details)
+
+** New convenience function `scm_c_symbol_length ()'
+
 * Bugs fixed
 
 ** Internal `scm_i_' functions now have "hidden" linkage with GCC/ELF
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi
index b2b5b07..e1db2a6 100755
--- a/doc/ref/api-data.texi
+++ b/doc/ref/api-data.texi
@@ -4647,6 +4647,11 @@ immediately after creating the Scheme string.  In certain cases, Guile
 can then use @var{str} directly as its internal representation.
 @end deftypefn
 
+The size of a symbol can also be obtained from C:
+
+@deftypefn {C Function} size_t scm_c_symbol_length (SCM sym)
+Return the number of characters in @var{sym}.
+@end deftypefn
 
 Finally, some applications, especially those that generate new Scheme
 code dynamically, need to generate symbols for use in the generated
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index da11608..f59a9b1 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -1220,7 +1220,7 @@ scm_i_deprecated_symbol_length (SCM sym)
 {
   scm_c_issue_deprecation_warning
     ("SCM_SYMBOL_LENGTH is deprecated.  Use scm_symbol_to_string.");
-  return scm_i_symbol_length (sym);
+  return scm_c_symbol_length (sym);
 }
 
 int
diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c
index 77f3ec2..f5fa057 100644
--- a/libguile/gc-mark.c
+++ b/libguile/gc-mark.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006, 2008 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
@@ -232,7 +232,7 @@ scm_gc_mark_dependencies (SCM p)
 	scm_t_bits word0 = SCM_CELL_WORD_0 (ptr) - scm_tc3_struct;
 	scm_t_bits * vtable_data = (scm_t_bits *) word0;
 	SCM layout = SCM_PACK (vtable_data [scm_vtable_index_layout]);
-	long len = scm_i_symbol_length (layout);
+	long len = scm_c_symbol_length (layout);
 	const char *fields_desc = scm_i_symbol_chars (layout);
 	scm_t_bits *struct_data = (scm_t_bits *) SCM_STRUCT_DATA (ptr);
 
diff --git a/libguile/print.c b/libguile/print.c
index fb9a74e..85d9ca2 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995-1999,2000,2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1999,2000,2001, 2002, 2003, 2004, 2006, 2008 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
@@ -589,7 +589,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 	  if (scm_i_symbol_is_interned (exp))
 	    {
 	      scm_print_symbol_name (scm_i_symbol_chars (exp),
-				     scm_i_symbol_length (exp),
+				     scm_c_symbol_length (exp),
 				     port);
 	      scm_remember_upto_here_1 (exp);
 	    }
@@ -597,7 +597,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 	    {
 	      scm_puts ("#<uninterned-symbol ", port);
 	      scm_print_symbol_name (scm_i_symbol_chars (exp),
-				     scm_i_symbol_length (exp),
+				     scm_c_symbol_length (exp),
 				     port);
 	      scm_putc (' ', port);
 	      scm_uintprint (SCM_UNPACK (exp), 16, port);
diff --git a/libguile/strings.c b/libguile/strings.c
index c322132..975f261 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -447,10 +447,14 @@ scm_i_c_take_symbol (char *name, size_t len,
 }
 
 size_t
-scm_i_symbol_length (SCM sym)
+scm_c_symbol_length (SCM sym)
+#define FUNC_NAME "scm_c_symbol_length"
 {
+  SCM_VALIDATE_SYMBOL (1, sym);
+
   return STRINGBUF_LENGTH (SYMBOL_STRINGBUF (sym));
 }
+#undef FUNC_NAME
 
 const char *
 scm_i_symbol_chars (SCM sym)
diff --git a/libguile/strings.h b/libguile/strings.h
index 04ae552..9272c2f 100644
--- a/libguile/strings.h
+++ b/libguile/strings.h
@@ -90,6 +90,7 @@ SCM_API SCM scm_string_append (SCM args);
 
 SCM_API SCM scm_c_make_string (size_t len, SCM chr);
 SCM_API size_t scm_c_string_length (SCM str);
+SCM_API size_t scm_c_symbol_length (SCM sym);
 SCM_API SCM scm_c_string_ref (SCM str, size_t pos);
 SCM_API void scm_c_string_set_x (SCM str, size_t pos, SCM chr);
 SCM_API SCM scm_c_substring (SCM str, size_t start, size_t end);
@@ -131,7 +132,6 @@ SCM_INTERNAL SCM
 scm_i_c_take_symbol (char *name, size_t len,
 		     scm_t_bits flags, unsigned long hash, SCM props);
 SCM_INTERNAL const char *scm_i_symbol_chars (SCM sym);
-SCM_INTERNAL size_t scm_i_symbol_length (SCM sym);
 SCM_INTERNAL SCM scm_i_symbol_substring (SCM sym, size_t start, size_t end);
 
 /* internal GC functions. */
diff --git a/libguile/struct.c b/libguile/struct.c
index 2d36303..f24ffb3 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008 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
@@ -140,7 +140,7 @@ scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, int tail_elts, SCM in
   unsigned const char *fields_desc =
     (unsigned const char *) scm_i_symbol_chars (layout) - 2;
   unsigned char prot = 0;
-  int n_fields = scm_i_symbol_length (layout) / 2;
+  int n_fields = scm_c_symbol_length (layout) / 2;
   int tailp = 0;
 
   while (n_fields)
@@ -243,7 +243,7 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
 
   layout = SCM_STRUCT_LAYOUT (x);
 
-  if (scm_i_symbol_length (layout)
+  if (scm_c_symbol_length (layout)
       < scm_i_string_length (required_vtable_fields))
     return SCM_BOOL_F;
 
@@ -428,7 +428,7 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
   SCM_VALIDATE_REST_ARGUMENT (init);
 
   layout = SCM_PACK (SCM_STRUCT_DATA (vtable) [scm_vtable_index_layout]);
-  basic_size = scm_i_symbol_length (layout) / 2;
+  basic_size = scm_c_symbol_length (layout) / 2;
   tail_elts = scm_to_size_t (tail_array_size);
 
   /* A tail array is only allowed if the layout fields string ends in "R",
@@ -544,7 +544,7 @@ SCM_DEFINE (scm_make_vtable_vtable, "make-vtable-vtable", 2, 0, 1,
   fields = scm_string_append (scm_list_2 (required_vtable_fields,
 					  user_fields));
   layout = scm_make_struct_layout (fields);
-  basic_size = scm_i_symbol_length (layout) / 2;
+  basic_size = scm_c_symbol_length (layout) / 2;
   tail_elts = scm_to_size_t (tail_array_size);
   SCM_CRITICAL_SECTION_START;
   data = scm_alloc_struct (basic_size + tail_elts,
@@ -602,7 +602,7 @@ scm_i_struct_equalp (SCM s1, SCM s2)
     return SCM_BOOL_F;
 
   layout = SCM_STRUCT_LAYOUT (s1);
-  struct_size = scm_i_symbol_length (layout) / 2;
+  struct_size = scm_c_symbol_length (layout) / 2;
 
   for (field_num = 0; field_num < struct_size; field_num++)
     {
@@ -658,7 +658,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
   p = scm_to_size_t (pos);
 
   fields_desc = scm_i_symbol_chars (layout);
-  layout_len = scm_i_symbol_length (layout);
+  layout_len = scm_c_symbol_length (layout);
   if (SCM_STRUCT_VTABLE_FLAGS (handle) & SCM_STRUCTF_LIGHT)
     /* no extra words */
     n_fields = layout_len / 2;
@@ -739,7 +739,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
   p = scm_to_size_t (pos);
 
   fields_desc = scm_i_symbol_chars (layout);
-  layout_len = scm_i_symbol_length (layout);
+  layout_len = scm_c_symbol_length (layout);
   if (SCM_STRUCT_VTABLE_FLAGS (handle) & SCM_STRUCTF_LIGHT)
     /* no extra words */
     n_fields = layout_len / 2;
diff --git a/libguile/symbols.c b/libguile/symbols.c
index d786dd9..7323fdd 100644
--- a/libguile/symbols.c
+++ b/libguile/symbols.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008 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
@@ -101,7 +101,7 @@ lookup_interned_symbol (const char *name, size_t len,
     {
       SCM sym = SCM_CAAR (l);
       if (scm_i_symbol_hash (sym) == raw_hash
-	  && scm_i_symbol_length (sym) == len)
+	  && scm_c_symbol_length (sym) == len)
 	{
 	  const char *chrs = scm_i_symbol_chars (sym);
 	  size_t i = len;
@@ -251,7 +251,7 @@ SCM_DEFINE (scm_symbol_to_string, "symbol->string", 1, 0, 0,
 #define FUNC_NAME s_scm_symbol_to_string
 {
   SCM_VALIDATE_SYMBOL (1, s);
-  return scm_i_symbol_substring (s, 0, scm_i_symbol_length (s));
+  return scm_i_symbol_substring (s, 0, scm_c_symbol_length (s));
 }
 #undef FUNC_NAME
 
-- 
1.5.6.1