diff options
author | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2000-10-26 18:18:28 +0000 |
---|---|---|
committer | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2000-10-26 18:18:28 +0000 |
commit | e9bfab50e4ec7787db05605727a06f98fe30f5b6 (patch) | |
tree | 2281aa0aaf6967a7eeed0063dbff031454fc0d3e | |
parent | c6c2ea9fa8ca18f59d37b0d6d1d52d36e11626ea (diff) | |
download | guile-e9bfab50e4ec7787db05605727a06f98fe30f5b6.tar.gz |
* String comparison functions don't accept symbols as arguments any more.
* Added macro SCM_STRING_COERCE_0TERMINATION_X.
-rw-r--r-- | libguile/ChangeLog | 15 | ||||
-rw-r--r-- | libguile/random.c | 1 | ||||
-rw-r--r-- | libguile/strings.h | 4 | ||||
-rw-r--r-- | libguile/strorder.c | 135 |
4 files changed, 98 insertions, 57 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 <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 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) { - return SCM_BOOL_F; + 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; } - c1 = SCM_ROUCHARS (s1); - c2 = SCM_ROUCHARS (s2); - while (0 != i--) - if (*c1++ != *c2++) + else + { 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) { - return SCM_BOOL_F; + 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; } - c1 = SCM_ROUCHARS (s1); - c2 = SCM_ROUCHARS (s2); - while (0 != i--) - if (scm_upcase(*c1++) != scm_upcase(*c2++)) + else + { 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; - register unsigned char *c1, *c2; - register int c; - - SCM_VALIDATE_ROSTRING (1,s1); - SCM_VALIDATE_ROSTRING (2,s2); - len = SCM_ROLENGTH (s1); - s2len = SCM_ROLENGTH (s2); - if (len>s2len) 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;i<len;i++) { - c = (*c1++ - *c2++); - if (c>0) - 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-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; - register unsigned char *c1, *c2; - register int c; - SCM_VALIDATE_ROSTRING (1,s1); - SCM_VALIDATE_ROSTRING (2,s2); - len = SCM_ROLENGTH (s1); - s2len = SCM_ROLENGTH (s2); - if (len>s2len) 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;i<len;i++) { - c = (scm_upcase(*c1++) - scm_upcase(*c2++)); - if (c>0) 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" |