[uim-commit] r2973 - in branches/r5rs/sigscheme: doc src
yamaken at freedesktop.org
yamaken at freedesktop.org
Sun Jan 22 08:38:01 PST 2006
Author: yamaken
Date: 2006-01-22 08:37:57 -0800 (Sun, 22 Jan 2006)
New Revision: 2973
Modified:
branches/r5rs/sigscheme/doc/spec.txt
branches/r5rs/sigscheme/src/operations.c
branches/r5rs/sigscheme/src/sigscheme.h
Log:
* sigscheme/src/sigscheme.h
- (scm_p_char_lessp, scm_p_char_greaterp, scm_p_char_greaterp,
scm_p_char_less_equalp, scm_p_char_greater_equalp,
scm_p_char_ci_equalp, scm_p_char_ci_lessp, scm_p_char_ci_greaterp,
scm_p_char_ci_less_equalp, scm_p_char_ci_greater_equalp): New function
* sigscheme/src/operations.c
- (ICHAR_DOWNCASE, ICHAR_UPCASE, CHAR_CMP_BODY, CHAR_CI_CMP_BODY):
New macro
- (scm_p_char_lessp, scm_p_char_greaterp, scm_p_char_greaterp,
scm_p_char_less_equalp, scm_p_char_greater_equalp,
scm_p_char_ci_equalp, scm_p_char_ci_lessp, scm_p_char_ci_greaterp,
scm_p_char_ci_less_equalp, scm_p_char_ci_greater_equalp): New function
- (scm_p_char_upcase, scm_p_char_downcase): Simplify with new macro
* sigscheme/doc/spec.txt
- Update
Modified: branches/r5rs/sigscheme/doc/spec.txt
===================================================================
--- branches/r5rs/sigscheme/doc/spec.txt 2006-01-22 15:46:53 UTC (rev 2972)
+++ branches/r5rs/sigscheme/doc/spec.txt 2006-01-22 16:37:57 UTC (rev 2973)
@@ -212,18 +212,6 @@
procedure: exact->inexact z
procedure: inexact->exact z
- * Characters
-
- procedure: char<? char1 char2
- procedure: char>? char1 char2
- procedure: char<=? char1 char2
- procedure: char>=? char1 char2
- library procedure: char-ci=? char1 char2
- library procedure: char-ci<? char1 char2
- library procedure: char-ci>? char1 char2
- library procedure: char-ci<=? char1 char2
- library procedure: char-ci>=? char1 char2
-
* Strings
library procedure: string-ci=? string1 string2
Modified: branches/r5rs/sigscheme/src/operations.c
===================================================================
--- branches/r5rs/sigscheme/src/operations.c 2006-01-22 15:46:53 UTC (rev 2972)
+++ branches/r5rs/sigscheme/src/operations.c 2006-01-22 16:37:57 UTC (rev 2973)
@@ -65,6 +65,11 @@
|| (SCM_STRING_LEN(str1) == SCM_STRING_LEN(str2) /* rough rejection */ \
&& strcmp(SCM_STRING_STR(str1), SCM_STRING_STR(str2)) == 0))
+/* FIXME: support SRFI-75 */
+/* get case insensitive character value */
+#define ICHAR_DOWNCASE(ch_val) ((isascii(ch_val)) ? tolower(ch_val) : (ch_val))
+#define ICHAR_UPCASE(ch_val) ((isascii(ch_val)) ? toupper(ch_val) : (ch_val))
+
/*=======================================
Variable Declarations
=======================================*/
@@ -1116,7 +1121,103 @@
#endif
}
+#define CHAR_CMP_BODY(op, ch1, ch2) \
+ do { \
+ ENSURE_CHAR(ch1); \
+ ENSURE_CHAR(ch2); \
+ \
+ return MAKE_BOOL(SCM_CHAR_VALUE(ch1) op SCM_CHAR_VALUE(ch2)); \
+ } while (/* CONSTCOND */ 0)
+
ScmObj
+scm_p_char_lessp(ScmObj ch1, ScmObj ch2)
+{
+ DECLARE_FUNCTION("char<?", procedure_fixed_2);
+
+ CHAR_CMP_BODY(<, ch1, ch2);
+}
+
+ScmObj
+scm_p_char_greaterp(ScmObj ch1, ScmObj ch2)
+{
+ DECLARE_FUNCTION("char>?", procedure_fixed_2);
+
+ CHAR_CMP_BODY(>, ch1, ch2);
+}
+
+ScmObj
+scm_p_char_less_equalp(ScmObj ch1, ScmObj ch2)
+{
+ DECLARE_FUNCTION("char<=?", procedure_fixed_2);
+
+ CHAR_CMP_BODY(<=, ch1, ch2);
+}
+
+ScmObj
+scm_p_char_greater_equalp(ScmObj ch1, ScmObj ch2)
+{
+ DECLARE_FUNCTION("char>=?", procedure_fixed_2);
+
+ CHAR_CMP_BODY(>=, ch1, ch2);
+}
+
+#define CHAR_CI_CMP_BODY(op, ch1, ch2) \
+ do { \
+ scm_ichar_t val1, val2; \
+ \
+ ENSURE_CHAR(ch1); \
+ ENSURE_CHAR(ch2); \
+ \
+ val1 = ICHAR_DOWNCASE(SCM_CHAR_VALUE(ch1)); \
+ val2 = ICHAR_DOWNCASE(SCM_CHAR_VALUE(ch2)); \
+ \
+ return MAKE_BOOL(val1 op val2); \
+ } while (/* CONSTCOND */ 0)
+
+ScmObj
+scm_p_char_ci_equalp(ScmObj ch1, ScmObj ch2)
+{
+ DECLARE_FUNCTION("char-ci=?", procedure_fixed_2);
+
+ CHAR_CI_CMP_BODY(==, ch1, ch2);
+}
+
+ScmObj
+scm_p_char_ci_lessp(ScmObj ch1, ScmObj ch2)
+{
+ DECLARE_FUNCTION("char-ci<?", procedure_fixed_2);
+
+ CHAR_CI_CMP_BODY(<, ch1, ch2);
+}
+
+ScmObj
+scm_p_char_ci_greaterp(ScmObj ch1, ScmObj ch2)
+{
+ DECLARE_FUNCTION("char-ci>?", procedure_fixed_2);
+
+ CHAR_CI_CMP_BODY(>, ch1, ch2);
+}
+
+ScmObj
+scm_p_char_ci_less_equalp(ScmObj ch1, ScmObj ch2)
+{
+ DECLARE_FUNCTION("char-ci<=?", procedure_fixed_2);
+
+ CHAR_CI_CMP_BODY(<=, ch1, ch2);
+}
+
+ScmObj
+scm_p_char_ci_greater_equalp(ScmObj ch1, ScmObj ch2)
+{
+ DECLARE_FUNCTION("char-ci>=?", procedure_fixed_2);
+
+ CHAR_CI_CMP_BODY(>=, ch1, ch2);
+}
+
+#undef CHAR_CMP_BODY
+#undef CHAR_CI_CMP_BODY
+
+ScmObj
scm_p_char_alphabeticp(ScmObj ch)
{
scm_ichar_t val;
@@ -1219,8 +1320,7 @@
ENSURE_CHAR(ch);
val = SCM_CHAR_VALUE(ch);
- if (isascii(val))
- SCM_CHAR_SET_VALUE(ch, toupper(val));
+ SCM_CHAR_SET_VALUE(ch, ICHAR_UPCASE(val));
return ch;
}
@@ -1234,8 +1334,7 @@
ENSURE_CHAR(ch);
val = SCM_CHAR_VALUE(ch);
- if (isascii(val))
- SCM_CHAR_SET_VALUE(ch, tolower(val));
+ SCM_CHAR_SET_VALUE(ch, ICHAR_DOWNCASE(val));
return ch;
}
Modified: branches/r5rs/sigscheme/src/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/src/sigscheme.h 2006-01-22 15:46:53 UTC (rev 2972)
+++ branches/r5rs/sigscheme/src/sigscheme.h 2006-01-22 16:37:57 UTC (rev 2973)
@@ -1206,7 +1206,16 @@
ScmObj scm_p_charp(ScmObj obj);
ScmObj scm_p_charequalp(ScmObj ch1, ScmObj ch2);
-/* TODO : many comparing functions around char is unimplemented */
+ScmObj scm_p_char_lessp(ScmObj ch1, ScmObj ch2);
+ScmObj scm_p_char_greaterp(ScmObj ch1, ScmObj ch2);
+ScmObj scm_p_char_greaterp(ScmObj ch1, ScmObj ch2);
+ScmObj scm_p_char_less_equalp(ScmObj ch1, ScmObj ch2);
+ScmObj scm_p_char_greater_equalp(ScmObj ch1, ScmObj ch2);
+ScmObj scm_p_char_ci_equalp(ScmObj ch1, ScmObj ch2);
+ScmObj scm_p_char_ci_lessp(ScmObj ch1, ScmObj ch2);
+ScmObj scm_p_char_ci_greaterp(ScmObj ch1, ScmObj ch2);
+ScmObj scm_p_char_ci_less_equalp(ScmObj ch1, ScmObj ch2);
+ScmObj scm_p_char_ci_greater_equalp(ScmObj ch1, ScmObj ch2);
ScmObj scm_p_char_alphabeticp(ScmObj ch);
ScmObj scm_p_char_numericp(ScmObj ch);
ScmObj scm_p_char_whitespacep(ScmObj ch);
More information about the uim-commit
mailing list