From e9bfab50e4ec7787db05605727a06f98fe30f5b6 Mon Sep 17 00:00:00 2001 From: Dirk Herrmann Date: Thu, 26 Oct 2000 18:18:28 +0000 Subject: [PATCH] * String comparison functions don't accept symbols as arguments any more. * Added macro SCM_STRING_COERCE_0TERMINATION_X. --- libguile/ChangeLog | 15 +++++ libguile/random.c | 1 + libguile/strings.h | 4 ++ libguile/strorder.c | 133 +++++++++++++++++++++++++------------------- 4 files changed, 97 insertions(+), 56 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 43756efcf..cff3cdf6a 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,18 @@ +2000-10-26 Dirk Herrmann + + * 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 This change merges the GOOPS code into Guile. However, GOOPS diff --git a/libguile/random.c b/libguile/random.c index 6467bb8e3..4ff289f4b 100644 --- a/libguile/random.c +++ b/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" diff --git a/libguile/strings.h b/libguile/strings.h index e6a9cf8b6..8e3ca5eb3 100644 --- a/libguile/strings.h +++ b/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); diff --git a/libguile/strorder.c b/libguile/strorder.c index 8d2453fea..c370aca77 100644 --- a/libguile/strorder.c +++ b/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; - register unsigned char *c1, *c2; - SCM_VALIDATE_ROSTRING (1,s1); - SCM_VALIDATE_ROSTRING (2,s2); + scm_sizet length; - i = SCM_ROLENGTH (s2); - if (SCM_ROLENGTH (s1) != i) + SCM_VALIDATE_STRING (1, s1); + 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; - register unsigned char *c1, *c2; - SCM_VALIDATE_ROSTRING (1,s1); - SCM_VALIDATE_ROSTRING (2,s2); + scm_sizet length; - i = SCM_ROLENGTH (s2); - if (SCM_ROLENGTH (s1) != i) + SCM_VALIDATE_STRING (1, s1); + 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, "strings2len) len = s2len; + SCM_VALIDATE_STRING (1, s1); + SCM_VALIDATE_STRING (2, s2); + + length1 = SCM_STRING_LENGTH (s1); + length2 = SCM_STRING_LENGTH (s2); + lengthm = min (length1, length2); c1 = SCM_ROUCHARS (s1); c2 = SCM_ROUCHARS (s2); - for (i = 0;i0) - return SCM_BOOL_F; - if (c<0) - return SCM_BOOL_T; - } - { - SCM answer; - answer = SCM_BOOL(s2len != len); - return answer; + for (i = 0; i != lengthm; ++i, ++c1, ++c2) { + int c = *c1 - *c2; + if (c < 0) return SCM_BOOL_T; + if (c > 0) return SCM_BOOL_F; } + + 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-cis2len) len = s2len; + scm_sizet i, length1, length2, lengthm; + unsigned char *c1, *c2; + + SCM_VALIDATE_STRING (1, s1); + SCM_VALIDATE_STRING (2, s2); + + length1 = SCM_STRING_LENGTH (s1); + length2 = SCM_STRING_LENGTH (s2); + lengthm = min (length1, length2); c1 = SCM_ROUCHARS (s1); c2 = SCM_ROUCHARS (s2); - for (i = 0;i0) return SCM_BOOL_F; - if (c<0) return SCM_BOOL_T; + + for (i = 0; i != lengthm; ++i, ++c1, ++c2) { + int c = scm_upcase (*c1) - scm_upcase (*c2); + 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"