Hello developers, here is the fix for the error message problem in `string>?' and others I promised. Regards, 'Martin -- Martin Grabmueller [EMAIL PROTECTED] http://www.pintus.de/mgrabmue/ mgrabmue@#lkcc on EFnet ===File ~/cvs/guile-core/libguile/strorder-diff============= Index: strorder.c =================================================================== RCS file: /cvs/guile/guile-core/libguile/strorder.c,v retrieving revision 1.20 diff -c -r1.20 strorder.c *** strorder.c 2000/11/22 11:20:03 1.20 --- strorder.c 2001/01/24 16:35:52 *************** *** 123,141 **** } #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 { 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); --- 123,137 ---- } #undef FUNC_NAME ! /* Internal helper function for the lexicographic ordering predicates. ! This function is only intended to be used internally, because it ! does not perform any argument checking. */ ! static SCM ! scm_i_string_less_p (SCM s1, SCM s2) { scm_sizet i, length1, length2, lengthm; unsigned char *c1, *c2; length1 = SCM_STRING_LENGTH (s1); length2 = SCM_STRING_LENGTH (s2); lengthm = min (length1, length2); *************** *** 150,155 **** --- 146,163 ---- return SCM_BOOL (length1 < length2); } + + 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 + { + SCM_VALIDATE_STRING (1, s1); + SCM_VALIDATE_STRING (2, s2); + + return scm_i_string_less_p (s1, s2); + } #undef FUNC_NAME *************** *** 159,165 **** "is lexicographically less than or equal to @var{s2}. (r5rs)") #define FUNC_NAME s_scm_string_leq_p { ! return SCM_BOOL_NOT (scm_string_less_p (s2, s1)); } #undef FUNC_NAME --- 167,176 ---- "is lexicographically less than or equal to @var{s2}. (r5rs)") #define FUNC_NAME s_scm_string_leq_p { ! SCM_VALIDATE_STRING (1, s1); ! SCM_VALIDATE_STRING (2, s2); ! ! return SCM_BOOL_NOT (scm_i_string_less_p (s2, s1)); } #undef FUNC_NAME *************** *** 170,176 **** "is lexicographically greater than @var{s2}. (r5rs)") #define FUNC_NAME s_scm_string_gr_p { ! return scm_string_less_p (s2, s1); } #undef FUNC_NAME --- 181,190 ---- "is lexicographically greater than @var{s2}. (r5rs)") #define FUNC_NAME s_scm_string_gr_p { ! SCM_VALIDATE_STRING (1, s1); ! SCM_VALIDATE_STRING (2, s2); ! ! return scm_i_string_less_p (s2, s1); } #undef FUNC_NAME *************** *** 181,204 **** "is lexicographically greater than or equal to @var{s2}. (r5rs)") #define FUNC_NAME s_scm_string_geq_p { ! return SCM_BOOL_NOT (scm_string_less_p (s1, s2)); } #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" ! "returns @t{#t} if @var{s1} is lexicographically less than\n" ! "@var{s2} regardless of case. (r5rs)") ! #define FUNC_NAME s_scm_string_ci_less_p { 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); --- 195,217 ---- "is lexicographically greater than or equal to @var{s2}. (r5rs)") #define FUNC_NAME s_scm_string_geq_p { ! SCM_VALIDATE_STRING (1, s1); ! SCM_VALIDATE_STRING (2, s2); ! ! return SCM_BOOL_NOT (scm_i_string_less_p (s1, s2)); } #undef FUNC_NAME ! /* Internal helper function for the case-insensitive lexicographic ! ordering predicates. This function is only intended to be used ! internally, because it does not perform any argument checking. */ ! static SCM ! scm_i_string_ci_less_p (SCM s1, SCM s2) { scm_sizet i, length1, length2, lengthm; unsigned char *c1, *c2; length1 = SCM_STRING_LENGTH (s1); length2 = SCM_STRING_LENGTH (s2); lengthm = min (length1, length2); *************** *** 213,218 **** --- 226,244 ---- return SCM_BOOL (length1 < length2); } + + SCM_DEFINE1 (scm_string_ci_less_p, "string-ci<?", scm_tc7_rpsubr, + (SCM s1, SCM s2), + "Case insensitive lexicographic ordering predicate; \n" + "returns @t{#t} if @var{s1} is lexicographically less than\n" + "@var{s2} regardless of case. (r5rs)") + #define FUNC_NAME s_scm_string_ci_less_p + { + SCM_VALIDATE_STRING (1, s1); + SCM_VALIDATE_STRING (2, s2); + + return scm_i_string_ci_less_p (s1, s2); + } #undef FUNC_NAME *************** *** 223,229 **** "or equal to @var{s2} regardless of case. (r5rs)") #define FUNC_NAME s_scm_string_ci_leq_p { ! return SCM_BOOL_NOT (scm_string_ci_less_p (s2, s1)); } #undef FUNC_NAME --- 249,258 ---- "or equal to @var{s2} regardless of case. (r5rs)") #define FUNC_NAME s_scm_string_ci_leq_p { ! SCM_VALIDATE_STRING (1, s1); ! SCM_VALIDATE_STRING (2, s2); ! ! return SCM_BOOL_NOT (scm_i_string_ci_less_p (s2, s1)); } #undef FUNC_NAME *************** *** 235,241 **** "@var{s2} regardless of case. (r5rs)") #define FUNC_NAME s_scm_string_ci_gr_p { ! return scm_string_ci_less_p (s2, s1); } #undef FUNC_NAME --- 264,273 ---- "@var{s2} regardless of case. (r5rs)") #define FUNC_NAME s_scm_string_ci_gr_p { ! SCM_VALIDATE_STRING (1, s1); ! SCM_VALIDATE_STRING (2, s2); ! ! return scm_i_string_ci_less_p (s2, s1); } #undef FUNC_NAME *************** *** 247,253 **** "or equal to @var{s2} regardless of case. (r5rs)") #define FUNC_NAME s_scm_string_ci_geq_p { ! return SCM_BOOL_NOT (scm_string_ci_less_p (s1, s2)); } #undef FUNC_NAME --- 279,288 ---- "or equal to @var{s2} regardless of case. (r5rs)") #define FUNC_NAME s_scm_string_ci_geq_p { ! SCM_VALIDATE_STRING (1, s1); ! SCM_VALIDATE_STRING (2, s2); ! ! return SCM_BOOL_NOT (scm_i_string_ci_less_p (s1, s2)); } #undef FUNC_NAME ============================================================ _______________________________________________ Bug-guile mailing list [EMAIL PROTECTED] http://mail.gnu.org/mailman/listinfo/bug-guile
