Use string accessors for string->number conversion

* libguile/numbers.c (scm_i_print_fraction): use string accessors
  (XDIGIT2UINT): use libunistring function
  (mem2uinteger, mem2integer, mem2decimal_from_point, mem2ureal)
  (mem2complex): take scheme string instead of c string; use accessors
  (scm_i_string_to_number): new function
  (scm_c_locale_string_to_number): use scm_i_string_to_number

* libguile/numbers.h: declaration for scm_i_string_to_number

* libguile/strings.c (scm_i_string_strcmp): new function

* libguile/strings.h: declaration for scm_i_string_strcmp

libguile/numbers.c

@@ -46,8 +46,9 @@
 #endif
 
 #include <math.h>
-#include <ctype.h>
 #include <string.h>
+#include <unicase.h>
+#include <unictype.h>
 
 #if HAVE_COMPLEX_H
 #include <complex.h>
@@ -2437,7 +2438,7 @@ scm_i_print_fraction (SCM sexp, SCM port, scm_print_state *pstate SCM_UNUSED)
 {
   SCM str;
   str = scm_number_to_string (sexp, SCM_UNDEFINED);
-  scm_lfwrite (scm_i_string_chars (str), scm_i_string_length (str), port);
+  scm_lfwrite_str (str, port);
   scm_remember_upto_here_1 (str);
   return !0;
 }
@@ -2485,12 +2486,12 @@ enum t_exactness {NO_EXACTNESS, INEXACT, EXACT};
 
 /* In non ASCII-style encodings the following macro might not work. */
 #define XDIGIT2UINT(d)                                                  \
-  (isdigit ((int) (unsigned char) d)                    \
+  (uc_is_property_decimal_digit ((int) (unsigned char) d)               \
    ? (d) - '0'                                                          \
    : tolower ((int) (unsigned char) d) - 'a' + 10)
 
 static SCM
-mem2uinteger (const char* mem, size_t len, unsigned int *p_idx,
+mem2uinteger (SCM mem, unsigned int *p_idx,
 	      unsigned int radix, enum t_exactness *p_exactness)
 {
   unsigned int idx = *p_idx;
@@ -2500,12 +2501,13 @@ mem2uinteger (const char* mem, size_t len, unsigned int *p_idx,
   unsigned int digit_value;
   SCM result;
   char c;
+  size_t len = scm_i_string_length (mem);
 
   if (idx == len)
     return SCM_BOOL_F;
 
-  c = mem[idx];
+  c = scm_i_string_ref (mem, idx);
-  if (!isxdigit ((int) (unsigned char) c))
+  if (!uc_is_property_ascii_hex_digit ((scm_t_uint32) c))
     return SCM_BOOL_F;
   digit_value = XDIGIT2UINT (c);
   if (digit_value >= radix)
@@ -2515,8 +2517,8 @@ mem2uinteger (const char* mem, size_t len, unsigned int *p_idx,
   result = SCM_I_MAKINUM (digit_value);
   while (idx != len)
     {
-      char c = mem[idx];
+      scm_t_wchar c = scm_i_string_ref (mem, idx);
-      if (isxdigit ((int) (unsigned char) c))
+      if (uc_is_property_ascii_hex_digit ((scm_t_uint32) c))
 	{
 	  if (hash_seen)
 	    break;
@@ -2569,20 +2571,20 @@ mem2uinteger (const char* mem, size_t len, unsigned int *p_idx,
  * has already been seen in the digits before the point.
  */
 
-/* In non ASCII-style encodings the following macro might not work. */
+#define DIGIT2UINT(d) (uc_numeric_value(d).numerator)
-#define DIGIT2UINT(d) ((d) - '0')
 
 static SCM
-mem2decimal_from_point (SCM result, const char* mem, size_t len, 
+mem2decimal_from_point (SCM result, SCM mem, 
 			unsigned int *p_idx, enum t_exactness *p_exactness)
 {
   unsigned int idx = *p_idx;
   enum t_exactness x = *p_exactness;
+  size_t len = scm_i_string_length (mem);
 
   if (idx == len)
     return result;
 
-  if (mem[idx] == '.')
+  if (scm_i_string_ref (mem, idx) == '.')
     {
       scm_t_bits shift = 1;
       scm_t_bits add = 0;
@@ -2592,8 +2594,8 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
       idx++;
       while (idx != len)
 	{
-	  char c = mem[idx];
+	  scm_t_wchar c = scm_i_string_ref (mem, idx);
-	  if (isdigit ((int) (unsigned char) c))
+	  if (uc_is_property_decimal_digit ((scm_t_uint32) c))
 	    {
 	      if (x == INEXACT)
 		return SCM_BOOL_F;
@@ -2643,13 +2645,13 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
     {
       int sign = 1;
       unsigned int start;
-      char c;
+      scm_t_wchar c;
       int exponent;
       SCM e;
 
       /* R5RS, section 7.1.1, lexical structure of numbers: <suffix> */
 
-      switch (mem[idx])
+      switch (scm_i_string_ref (mem, idx))
 	{
 	case 'd': case 'D':
 	case 'e': case 'E':
@@ -2661,7 +2663,7 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
             return SCM_BOOL_F;
 
 	  start = idx;
-	  c = mem[idx];
+	  c = scm_i_string_ref (mem, idx);
 	  if (c == '-')
 	    {
 	      idx++;
@@ -2669,7 +2671,7 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
                 return SCM_BOOL_F;
 
 	      sign = -1;
-	      c = mem[idx];
+	      c = scm_i_string_ref (mem, idx);
 	    }
 	  else if (c == '+')
 	    {
@@ -2678,20 +2680,20 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
                 return SCM_BOOL_F;
 
 	      sign = 1;
-	      c = mem[idx];
+	      c = scm_i_string_ref (mem, idx);
 	    }
 	  else
 	    sign = 1;
 
-	  if (!isdigit ((int) (unsigned char) c))
+	  if (!uc_is_property_decimal_digit ((scm_t_uint32) c))
 	    return SCM_BOOL_F;
 
 	  idx++;
 	  exponent = DIGIT2UINT (c);
 	  while (idx != len)
 	    {
-	      char c = mem[idx];
+	      scm_t_wchar c = scm_i_string_ref (mem, idx);
-	      if (isdigit ((int) (unsigned char) c))
+	      if (uc_is_property_decimal_digit ((scm_t_uint32) c))
 		{
 		  idx++;
 		  if (exponent <= SCM_MAXEXP)
@@ -2704,7 +2706,7 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
 	  if (exponent > SCM_MAXEXP)
 	    {
 	      size_t exp_len = idx - start;
-	      SCM exp_string = scm_from_locale_stringn (&mem[start], exp_len);
+	      SCM exp_string = scm_i_substring_copy (mem, start, start + exp_len);
 	      SCM exp_num = scm_string_to_number (exp_string, SCM_UNDEFINED);
 	      scm_out_of_range ("string->number", exp_num);
 	    }
@@ -2736,11 +2738,12 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
 /* R5RS, section 7.1.1, lexical structure of numbers: <ureal R> */
 
 static SCM
-mem2ureal (const char* mem, size_t len, unsigned int *p_idx,
+mem2ureal (SCM mem, unsigned int *p_idx,
 	   unsigned int radix, enum t_exactness *p_exactness)
 {
   unsigned int idx = *p_idx;
   SCM result;
+  size_t len = scm_i_string_length (mem);
 
   /* Start off believing that the number will be exact.  This changes
      to INEXACT if we see a decimal point or a hash. */
@@ -2749,45 +2752,45 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx,
   if (idx == len)
     return SCM_BOOL_F;
 
-  if (idx+5 <= len && !strncmp (mem+idx, "inf.0", 5))
+  if (idx+5 <= len && !scm_i_string_strcmp (mem, idx, "inf.0"))
     {
       *p_idx = idx+5;
       return scm_inf ();
     }
 
-  if (idx+4 < len && !strncmp (mem+idx, "nan.", 4))
+  if (idx+4 < len && !scm_i_string_strcmp (mem, idx, "nan."))
     {
       /* Cobble up the fractional part.  We might want to set the
 	 NaN's mantissa from it. */
       idx += 4;
-      mem2uinteger (mem, len, &idx, 10, &x);
+      mem2uinteger (mem, &idx, 10, &x);
       *p_idx = idx;
       return scm_nan ();
     }
 
-  if (mem[idx] == '.')
+  if (scm_i_string_ref (mem, idx) == '.')
     {
       if (radix != 10)
 	return SCM_BOOL_F;
       else if (idx + 1 == len)
 	return SCM_BOOL_F;
-      else if (!isdigit ((int) (unsigned char) mem[idx + 1]))
+      else if (!uc_is_property_decimal_digit ((scm_t_uint32) scm_i_string_ref (mem, idx+1)))
 	return SCM_BOOL_F;
       else
-	result = mem2decimal_from_point (SCM_I_MAKINUM (0), mem, len,
+	result = mem2decimal_from_point (SCM_I_MAKINUM (0), mem,
 					 p_idx, &x);
     }
   else
     {
       SCM uinteger;
 
-      uinteger = mem2uinteger (mem, len, &idx, radix, &x);
+      uinteger = mem2uinteger (mem, &idx, radix, &x);
       if (scm_is_false (uinteger))
 	return SCM_BOOL_F;
 
       if (idx == len)
 	result = uinteger;
-      else if (mem[idx] == '/')
+      else if (scm_i_string_ref (mem, idx) == '/')
 	{
 	  SCM divisor;
 
@@ -2795,7 +2798,7 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx,
           if (idx == len)
             return SCM_BOOL_F;
 
-          divisor = mem2uinteger (mem, len, &idx, radix, &x);
+	  divisor = mem2uinteger (mem, &idx, radix, &x);
 	  if (scm_is_false (divisor))
 	    return SCM_BOOL_F;
 
@@ -2804,7 +2807,7 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx,
 	}
       else if (radix == 10)
 	{
-	  result = mem2decimal_from_point (uinteger, mem, len, &idx, &x);
+	  result = mem2decimal_from_point (uinteger, mem, &idx, &x);
 	  if (scm_is_false (result))
 	    return SCM_BOOL_F;
 	}
@@ -2835,17 +2838,18 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx,
 /* R5RS, section 7.1.1, lexical structure of numbers: <complex R> */
 
 static SCM
-mem2complex (const char* mem, size_t len, unsigned int idx,
+mem2complex (SCM mem, unsigned int idx,
 	     unsigned int radix, enum t_exactness *p_exactness)
 {
-  char c;
+  scm_t_wchar c;
   int sign = 0;
   SCM ureal;
+  size_t len = scm_i_string_length (mem);
 
   if (idx == len)
     return SCM_BOOL_F;
 
-  c = mem[idx];
+  c = scm_i_string_ref (mem, idx);
   if (c == '+')
     {
       idx++;
@@ -2860,7 +2864,7 @@ mem2complex (const char* mem, size_t len, unsigned int idx,
   if (idx == len)
     return SCM_BOOL_F;
 
-  ureal = mem2ureal (mem, len, &idx, radix, p_exactness);
+  ureal = mem2ureal (mem, &idx, radix, p_exactness);
   if (scm_is_false (ureal))
     {
       /* input must be either +i or -i */
@@ -2868,7 +2872,8 @@ mem2complex (const char* mem, size_t len, unsigned int idx,
       if (sign == 0)
 	return SCM_BOOL_F;
 
-      if (mem[idx] == 'i' || mem[idx] == 'I')
+      if (scm_i_string_ref (mem, idx) == 'i'
+	  || scm_i_string_ref (mem, idx) == 'I')
 	{
 	  idx++;
 	  if (idx != len)
@@ -2887,7 +2892,7 @@ mem2complex (const char* mem, size_t len, unsigned int idx,
       if (idx == len)
 	return ureal;
 
-      c = mem[idx];
+      c = scm_i_string_ref (mem, idx);
       switch (c)
 	{
 	case 'i': case 'I':
@@ -2912,7 +2917,7 @@ mem2complex (const char* mem, size_t len, unsigned int idx,
 	      SCM angle;
 	      SCM result;
 
-	      c = mem[idx];
+	      c = scm_i_string_ref (mem, idx);
 	      if (c == '+')
 		{
 		  idx++;
@@ -2930,7 +2935,7 @@ mem2complex (const char* mem, size_t len, unsigned int idx,
 	      else
 		sign = 1;
 
-	      angle = mem2ureal (mem, len, &idx, radix, p_exactness);
+	      angle = mem2ureal (mem, &idx, radix, p_exactness);
 	      if (scm_is_false (angle))
 		return SCM_BOOL_F;
 	      if (idx != len)
@@ -2952,7 +2957,7 @@ mem2complex (const char* mem, size_t len, unsigned int idx,
 	  else
 	    {
 	      int sign = (c == '+') ? 1 : -1;
-	      SCM imag = mem2ureal (mem, len, &idx, radix, p_exactness);
+	      SCM imag = mem2ureal (mem, &idx, radix, p_exactness);
 
 	      if (scm_is_false (imag))
 		imag = SCM_I_MAKINUM (sign);
@@ -2961,7 +2966,8 @@ mem2complex (const char* mem, size_t len, unsigned int idx,
 
 	      if (idx == len)
 		return SCM_BOOL_F;
-	      if (mem[idx] != 'i' && mem[idx] != 'I')
+	      if (scm_i_string_ref (mem, idx) != 'i'
+		  && scm_i_string_ref (mem, idx) != 'I')
 		return SCM_BOOL_F;
 
 	      idx++;
@@ -2982,19 +2988,19 @@ mem2complex (const char* mem, size_t len, unsigned int idx,
 enum t_radix {NO_RADIX=0, DUAL=2, OCT=8, DEC=10, HEX=16};
 
 SCM
-scm_c_locale_stringn_to_number (const char* mem, size_t len,
+scm_i_string_to_number (SCM mem, unsigned int default_radix)
-				unsigned int default_radix)
 {
   unsigned int idx = 0;
   unsigned int radix = NO_RADIX;
   enum t_exactness forced_x = NO_EXACTNESS;
   enum t_exactness implicit_x = EXACT;
   SCM result;
+  size_t len = scm_i_string_length (mem);
 
   /* R5RS, section 7.1.1, lexical structure of numbers: <prefix R> */
-  while (idx + 2 < len && mem[idx] == '#')
+  while (idx + 2 < len && scm_i_string_ref (mem, idx) == '#')
     {
-      switch (mem[idx + 1])
+      switch (scm_i_string_ref (mem, idx + 1))
 	{
 	case 'b': case 'B':
 	  if (radix != NO_RADIX)
@@ -3034,9 +3040,9 @@ scm_c_locale_stringn_to_number (const char* mem, size_t len,
 
   /* R5RS, section 7.1.1, lexical structure of numbers: <complex R> */
   if (radix == NO_RADIX)
-    result = mem2complex (mem, len, idx, default_radix, &implicit_x);
+    result = mem2complex (mem, idx, default_radix, &implicit_x);
   else
-    result = mem2complex (mem, len, idx, (unsigned int) radix, &implicit_x);
+    result = mem2complex (mem, idx, (unsigned int) radix, &implicit_x);
 
   if (scm_is_false (result))
     return SCM_BOOL_F;
@@ -3067,6 +3073,15 @@ scm_c_locale_stringn_to_number (const char* mem, size_t len,
     }
 }
 
+SCM
+scm_c_locale_stringn_to_number (const char* mem, size_t len,
+				unsigned int default_radix)
+{
+  SCM str = scm_from_locale_stringn (mem, len);
+
+  return scm_i_string_to_number (str, default_radix);
+}
+
 
 SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 0,
             (SCM string, SCM radix),
@@ -3089,9 +3104,7 @@ SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 0,
   else
     base = scm_to_unsigned_integer (radix, 2, INT_MAX);
 
-  answer = scm_c_locale_stringn_to_number (scm_i_string_chars (string),
+  answer = scm_i_string_to_number (string, base);
-					   scm_i_string_length (string),
-					   base);
   scm_remember_upto_here_1 (string);
   return answer;
 }

libguile/numbers.h

@@ -212,6 +212,7 @@ SCM_API int scm_print_complex (SCM sexp, SCM port, scm_print_state *pstate);
 SCM_API int scm_bigprint (SCM exp, SCM port, scm_print_state *pstate);
 SCM_API SCM scm_c_locale_stringn_to_number (const char *mem, size_t len,
 					    unsigned int radix);
+SCM_INTERNAL SCM scm_i_string_to_number (SCM str, unsigned int radix);
 SCM_API SCM scm_string_to_number (SCM str, SCM radix);
 SCM_API SCM scm_bigequal (SCM x, SCM y);
 SCM_API SCM scm_real_equalp (SCM x, SCM y);

libguile/strings.c

@@ -590,6 +590,29 @@ scm_i_string_ref (SCM str, size_t x)
     return scm_i_string_wide_chars (str)[x];
 }
 
+int 
+scm_i_string_strcmp (SCM sstr, size_t start_x, const char *cstr)
+{
+  if (scm_i_is_narrow_string (sstr))
+    {
+      const char *a = scm_i_string_chars (sstr) + start_x;
+      const char *b = cstr;
+      return strncmp (a, b, strlen(b));
+    }
+  else
+    {
+      size_t i;
+      const scm_t_wchar *a = scm_i_string_wide_chars (sstr) + start_x;
+      const char *b = cstr;
+      for (i = 0; i < strlen (b); i++)
+        {
+          if (a[i] != (unsigned char) b[i])
+            return 1;
+        }
+    }
+  return 0;
+}
+
 /* Set the Pth character of STR to UCS-4 codepoint CHR. */
 void
 scm_i_string_set_x (SCM str, size_t p, scm_t_wchar chr)

libguile/strings.h

@@ -152,6 +152,7 @@ SCM_INTERNAL SCM scm_i_string_start_writing (SCM str);
 SCM_INTERNAL void scm_i_string_stop_writing (void);
 SCM_INTERNAL int scm_i_is_narrow_string (SCM str);
 SCM_INTERNAL scm_t_wchar scm_i_string_ref (SCM str, size_t x);
+SCM_INTERNAL int scm_i_string_strcmp (SCM sstr, size_t start_x, const char *cstr);
 SCM_INTERNAL void scm_i_string_set_x (SCM str, size_t p, scm_t_wchar chr);
 /* internal functions related to symbols. */