* String comparison functions don't accept symbols as arguments any more.

* Added macro SCM_STRING_COERCE_0TERMINATION_X.

libguile/ChangeLog

@@ -1,3 +1,18 @@
+2000-10-26  Dirk Herrmann  <D.Herrmann@tu-bs.de>
+
+	* random.c:  Include unif.h.
+
+	* strings.h (SCM_STRING_COERCE_0TERMINATION_X):  Added.  This is
+	intended to replace the macro SCM_COERCE_SUBSTR.  Such a macro
+	will be necessary, even after copy-on-write strings will be added
+	to guile, but the current naming is inappropriate.
+
+	* strorder.c (scm_string_equal_p, scm_string_ci_equal_p,
+	scm_string_less_p, scm_string_ci_less_p):  Don't accept symbols as
+	input parameters.  Further, the functions that test for equality
+	are rewritten to compare from back to front, the others are also a
+	little bit more polished.
+
 2000-10-25  Mikael Djurfeldt  <mdj@linnaeus.mit.edu>
 
 	This change merges the GOOPS code into Guile.  However, GOOPS

libguile/random.c

@@ -53,6 +53,7 @@
 #include "libguile/numbers.h"
 #include "libguile/feature.h"
 #include "libguile/strings.h"
+#include "libguile/unif.h"
 #include "libguile/vectors.h"
 
 #include "libguile/validate.h"

libguile/strings.h

@@ -59,6 +59,10 @@
 /* Is X a writable string (i.e., not a substring)?  */
 #define SCM_RWSTRINGP(x) (SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_string))
 
+#define SCM_STRING_COERCE_0TERMINATION_X(x) \
+  { if (SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_substring)) \
+      x = scm_makfromstr (SCM_ROCHARS (x), SCM_STRING_LENGTH (x), 0); }
+
 
 
 extern SCM scm_string_p (SCM x);

libguile/strorder.c

@@ -63,25 +63,33 @@ SCM_DEFINE1 (scm_string_equal_p, "string=?", scm_tc7_rpsubr,
 	     "@samp{string=?} treats upper and lower case as distinct characters.")
 #define FUNC_NAME s_scm_string_equal_p
 {
-  register scm_sizet i;
+  scm_sizet length;
-  register unsigned char *c1, *c2;
-  SCM_VALIDATE_ROSTRING (1,s1);
-  SCM_VALIDATE_ROSTRING (2,s2);
 
-  i = SCM_ROLENGTH (s2);
+  SCM_VALIDATE_STRING (1, s1);
-  if (SCM_ROLENGTH (s1) != i)
+  SCM_VALIDATE_STRING (2, s2);
+
+  length = SCM_STRING_LENGTH (s2);
+  if (SCM_STRING_LENGTH (s1) == length)
+    {
+      unsigned char *c1 = SCM_ROUCHARS (s1) + length - 1;
+      unsigned char *c2 = SCM_ROUCHARS (s2) + length - 1;
+      scm_sizet i;
+
+      /* comparing from back to front typically finds mismatches faster */
+      for (i = 0; i != length; ++i, --c1, --c2)
+	if (*c1 != *c2)
+	  return SCM_BOOL_F;
+
+      return SCM_BOOL_T;
+    }
+  else
     {
       return SCM_BOOL_F;
     }
-  c1 = SCM_ROUCHARS (s1);
-  c2 = SCM_ROUCHARS (s2);
-  while (0 != i--)
-    if (*c1++ != *c2++)
-      return SCM_BOOL_F;
-  return SCM_BOOL_T;
 }
 #undef FUNC_NAME
 
+
 SCM_DEFINE1 (scm_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr,
              (SCM s1, SCM s2),
 	     "Case-insensitive string equality predicate; returns @t{#t} if\n"
@@ -89,58 +97,62 @@ SCM_DEFINE1 (scm_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr,
 	     "match (ignoring case) at each position; otherwise returns @t{#f}. (r5rs)")
 #define FUNC_NAME s_scm_string_ci_equal_p
 {
-  register scm_sizet i;
+  scm_sizet length;
-  register unsigned char *c1, *c2;
-  SCM_VALIDATE_ROSTRING (1,s1);
-  SCM_VALIDATE_ROSTRING (2,s2);
 
-  i = SCM_ROLENGTH (s2);
+  SCM_VALIDATE_STRING (1, s1);
-  if (SCM_ROLENGTH (s1) != i)
+  SCM_VALIDATE_STRING (2, s2);
+
+  length = SCM_STRING_LENGTH (s2);
+  if (SCM_STRING_LENGTH (s1) == length)
+    {
+      unsigned char *c1 = SCM_ROUCHARS (s1) + length - 1;
+      unsigned char *c2 = SCM_ROUCHARS (s2) + length - 1;
+      scm_sizet i;
+
+      /* comparing from back to front typically finds mismatches faster */
+      for (i = 0; i != length; ++i, --c1, --c2)
+	if (scm_upcase (*c1) != scm_upcase (*c2))
+	  return SCM_BOOL_F;
+
+      return SCM_BOOL_T;
+    }
+  else
     {
       return SCM_BOOL_F;
     }
-  c1 = SCM_ROUCHARS (s1);
-  c2 = SCM_ROUCHARS (s2);
-  while (0 != i--)
-    if (scm_upcase(*c1++) != scm_upcase(*c2++))
-      return SCM_BOOL_F;
-  return SCM_BOOL_T;
 }
 #undef FUNC_NAME
 
+
 SCM_DEFINE1 (scm_string_less_p, "string<?", scm_tc7_rpsubr,
              (SCM s1, SCM s2),
 	     "Lexicographic ordering predicate; returns @t{#t} if @var{s1}\n"
 	     "is lexicographically less than @var{s2}.  (r5rs)")
 #define FUNC_NAME s_scm_string_less_p
 {
-  register scm_sizet i, len, s2len;
+  scm_sizet i, length1, length2, lengthm;
-  register unsigned char *c1, *c2;
+  unsigned char *c1, *c2;
-  register int c;
 
-  SCM_VALIDATE_ROSTRING (1,s1);
+  SCM_VALIDATE_STRING (1, s1);
-  SCM_VALIDATE_ROSTRING (2,s2);
+  SCM_VALIDATE_STRING (2, s2);
-  len = SCM_ROLENGTH (s1);
+
-  s2len = SCM_ROLENGTH (s2);
+  length1 = SCM_STRING_LENGTH (s1);
-  if (len>s2len) len = s2len;
+  length2 = SCM_STRING_LENGTH (s2);
+  lengthm = min (length1, length2);
   c1 = SCM_ROUCHARS (s1);
   c2 = SCM_ROUCHARS (s2);
 
-  for (i = 0;i<len;i++) {
+  for (i = 0; i != lengthm; ++i, ++c1, ++c2) {
-    c = (*c1++ - *c2++);
+    int c = *c1 - *c2;
-    if (c>0)
+    if (c < 0) return SCM_BOOL_T;
-      return SCM_BOOL_F;
+    if (c > 0) return SCM_BOOL_F;
-    if (c<0)
-      return SCM_BOOL_T;
-  }
-  {
-    SCM answer;
-    answer = SCM_BOOL(s2len != len);
-    return answer;
   }
+
+  return SCM_BOOL (length1 < length2);
 }
 #undef FUNC_NAME
 
+
 SCM_DEFINE1 (scm_string_leq_p, "string<=?", scm_tc7_rpsubr,
              (SCM s1, SCM s2),
 	     "Lexicographic ordering predicate; returns @t{#t} if @var{s1}\n"
@@ -151,6 +163,7 @@ SCM_DEFINE1 (scm_string_leq_p, "string<=?", scm_tc7_rpsubr,
 }
 #undef FUNC_NAME
 
+
 SCM_DEFINE1 (scm_string_gr_p, "string>?", scm_tc7_rpsubr,
              (SCM s1, SCM s2),
 	     "Lexicographic ordering predicate; returns @t{#t} if @var{s1}\n"
@@ -161,6 +174,7 @@ SCM_DEFINE1 (scm_string_gr_p, "string>?", scm_tc7_rpsubr,
 }
 #undef FUNC_NAME
 
+
 SCM_DEFINE1 (scm_string_geq_p, "string>=?", scm_tc7_rpsubr,
              (SCM s1, SCM s2),
 	     "Lexicographic ordering predicate; returns @t{#t} if @var{s1}\n"
@@ -171,6 +185,7 @@ SCM_DEFINE1 (scm_string_geq_p, "string>=?", scm_tc7_rpsubr,
 }
 #undef FUNC_NAME
 
+
 SCM_DEFINE1 (scm_string_ci_less_p, "string-ci<?", scm_tc7_rpsubr,
              (SCM s1, SCM s2),
 	     "Case insensitive lexicographic ordering predicate; \n"
@@ -178,25 +193,29 @@ SCM_DEFINE1 (scm_string_ci_less_p, "string-ci<?", scm_tc7_rpsubr,
 	     "@var{s2} regardless of case.  (r5rs)")
 #define FUNC_NAME s_scm_string_ci_less_p
 {
-  register scm_sizet i, len, s2len;
+  scm_sizet i, length1, length2, lengthm;
-  register unsigned char *c1, *c2;
+  unsigned char *c1, *c2;
-  register int c;
+
-  SCM_VALIDATE_ROSTRING (1,s1);
+  SCM_VALIDATE_STRING (1, s1);
-  SCM_VALIDATE_ROSTRING (2,s2);
+  SCM_VALIDATE_STRING (2, s2);
-  len = SCM_ROLENGTH (s1);
+
-  s2len = SCM_ROLENGTH (s2);
+  length1 = SCM_STRING_LENGTH (s1);
-  if (len>s2len) len = s2len;
+  length2 = SCM_STRING_LENGTH (s2);
+  lengthm = min (length1, length2);
   c1 = SCM_ROUCHARS (s1);
   c2 = SCM_ROUCHARS (s2);
-  for (i = 0;i<len;i++) {
+
-    c = (scm_upcase(*c1++) - scm_upcase(*c2++));
+  for (i = 0; i != lengthm; ++i, ++c1, ++c2) {
-    if (c>0) return SCM_BOOL_F;
+    int c = scm_upcase (*c1) - scm_upcase (*c2);
-    if (c<0) return SCM_BOOL_T;
+    if (c < 0) return SCM_BOOL_T;
+    if (c > 0) return SCM_BOOL_F;
   }
-  return SCM_BOOL(s2len != len);
+
+  return SCM_BOOL (length1 < length2);
 }
 #undef FUNC_NAME
 
+
 SCM_DEFINE1 (scm_string_ci_leq_p, "string-ci<=?", scm_tc7_rpsubr,
              (SCM s1, SCM s2),
 	     "Case insensitive lexicographic ordering predicate; \n"
@@ -208,6 +227,7 @@ SCM_DEFINE1 (scm_string_ci_leq_p, "string-ci<=?", scm_tc7_rpsubr,
 }
 #undef FUNC_NAME
 
+
 SCM_DEFINE1 (scm_string_ci_gr_p, "string-ci>?", scm_tc7_rpsubr,
              (SCM s1, SCM s2),
 	     "Case insensitive lexicographic ordering predicate; \n"
@@ -219,6 +239,7 @@ SCM_DEFINE1 (scm_string_ci_gr_p, "string-ci>?", scm_tc7_rpsubr,
 }
 #undef FUNC_NAME
 
+
 SCM_DEFINE1 (scm_string_ci_geq_p, "string-ci>=?", scm_tc7_rpsubr,
              (SCM s1, SCM s2),
 	     "Case insensitive lexicographic ordering predicate; \n"