[uim-commit] r3076 - branches/r5rs/sigscheme/src
yamaken at freedesktop.org
yamaken at freedesktop.org
Thu Feb 2 02:19:58 PST 2006
Author: yamaken
Date: 2006-02-02 02:19:54 -0800 (Thu, 02 Feb 2006)
New Revision: 3076
Added:
branches/r5rs/sigscheme/src/char.c
Modified:
branches/r5rs/sigscheme/src/Makefile.am
branches/r5rs/sigscheme/src/sigscheme.h
branches/r5rs/sigscheme/src/sigschemeinternal.h
branches/r5rs/sigscheme/src/string.c
Log:
* sigscheme/src/string.c
- (ICHAR_DOWNCASE, ICHAR_UPCASE, ICHAR_FOLDCASE): Move to
sigschemeinternal.h
- (scm_p_charp, scm_p_char_equalp, 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,
scm_p_char_alphabeticp, scm_p_char_numericp,
scm_p_char_whitespacep, scm_p_char_upper_casep,
scm_p_char_lower_casep, scm_p_char2integer, scm_p_integer2char,
scm_p_char_upcase, scm_p_char_downcase, CHAR_CMP_BODY,
CHAR_CI_CMP_BODY): Move to char.c
* sigscheme/src/char.c
- New file copied from string.c
- (scm_p_charp, scm_p_char_equalp, 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,
scm_p_char_alphabeticp, scm_p_char_numericp,
scm_p_char_whitespacep, scm_p_char_upper_casep,
scm_p_char_lower_casep, scm_p_char2integer, scm_p_integer2char,
scm_p_char_upcase, scm_p_char_downcase, CHAR_CMP_BODY,
CHAR_CI_CMP_BODY): Moved from string.c
* sigscheme/src/sigschemeinternal.h
- (ICHAR_DOWNCASE, ICHAR_UPCASE, ICHAR_FOLDCASE): Moved from
string.c
* sigscheme/src/Makefile.am
- (R5RS_PROC_SRCS, libsscm_la_SOURCES): Add char.c
Modified: branches/r5rs/sigscheme/src/Makefile.am
===================================================================
--- branches/r5rs/sigscheme/src/Makefile.am 2006-02-02 10:17:05 UTC (rev 3075)
+++ branches/r5rs/sigscheme/src/Makefile.am 2006-02-02 10:19:54 UTC (rev 3076)
@@ -29,6 +29,9 @@
if USE_NUMBER
R5RS_PROC_SRCS += number.c
endif
+if USE_CHAR
+ R5RS_PROC_SRCS += char.c
+endif
if USE_STRING
R5RS_PROC_SRCS += string.c
endif
@@ -110,6 +113,9 @@
if USE_NUMBER
libsscm_la_SOURCES += number.c
endif
+if USE_CHAR
+ libsscm_la_SOURCES += char.c
+endif
if USE_STRING
libsscm_la_SOURCES += string.c
endif
Copied: branches/r5rs/sigscheme/src/char.c (from rev 3063, branches/r5rs/sigscheme/src/string.c)
===================================================================
--- branches/r5rs/sigscheme/src/string.c 2006-02-01 09:27:04 UTC (rev 3063)
+++ branches/r5rs/sigscheme/src/char.c 2006-02-02 10:19:54 UTC (rev 3076)
@@ -0,0 +1,311 @@
+/*===========================================================================
+ * FileName : char.c
+ * About : R5RS characters
+ *
+ * Copyright (C) 2005-2006 Kazuki Ohta <mover AT hct.zaq.ne.jp>
+ *
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. Neither the name of authors nor the names of its contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
+ * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+ * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
+ * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+===========================================================================*/
+
+#include "config.h"
+#include "config-nonstd-string.h"
+
+/*=======================================
+ System Include
+=======================================*/
+#include <ctype.h>
+#include <stdlib.h>
+
+/*=======================================
+ Local Include
+=======================================*/
+#include "sigscheme.h"
+#include "sigschemeinternal.h"
+
+/*=======================================
+ File Local Struct Declarations
+=======================================*/
+
+/*=======================================
+ File Local Macro Declarations
+=======================================*/
+
+/*=======================================
+ Variable Declarations
+=======================================*/
+
+/*=======================================
+ File Local Function Declarations
+=======================================*/
+
+/*=======================================
+ Function Implementations
+=======================================*/
+/*===========================================================================
+ R5RS : 6.3 Other data types : 6.3.4 Characters
+===========================================================================*/
+ScmObj
+scm_p_charp(ScmObj obj)
+{
+ DECLARE_FUNCTION("char?", procedure_fixed_1);
+
+ return MAKE_BOOL(CHARP(obj));
+}
+
+ScmObj
+scm_p_char_equalp(ScmObj ch1, ScmObj ch2)
+{
+ DECLARE_FUNCTION("char=?", procedure_fixed_2);
+
+ ENSURE_CHAR(ch1);
+ ENSURE_CHAR(ch2);
+
+#if SCM_HAS_IMMEDIATE_CHAR_ONLY
+ return MAKE_BOOL(EQ(ch1, ch2));
+#else
+ return MAKE_BOOL(SCM_CHAR_VALUE(ch1) == SCM_CHAR_VALUE(ch2));
+#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_FOLDCASE(SCM_CHAR_VALUE(ch1)); \
+ val2 = ICHAR_FOLDCASE(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;
+ DECLARE_FUNCTION("char-alphabetic?", procedure_fixed_1);
+
+ ENSURE_CHAR(ch);
+
+ val = SCM_CHAR_VALUE(ch);
+
+ return MAKE_BOOL(isascii(val) && isalpha(val));
+}
+
+ScmObj
+scm_p_char_numericp(ScmObj ch)
+{
+ scm_ichar_t val;
+ DECLARE_FUNCTION("char-numeric?", procedure_fixed_1);
+
+ ENSURE_CHAR(ch);
+
+ val = SCM_CHAR_VALUE(ch);
+
+ return MAKE_BOOL(isascii(val) && isdigit(val));
+}
+
+ScmObj
+scm_p_char_whitespacep(ScmObj ch)
+{
+ scm_ichar_t val;
+ DECLARE_FUNCTION("char-whitespace?", procedure_fixed_1);
+
+ ENSURE_CHAR(ch);
+
+ val = SCM_CHAR_VALUE(ch);
+
+ return MAKE_BOOL(isascii(val) && isspace(val));
+}
+
+ScmObj
+scm_p_char_upper_casep(ScmObj ch)
+{
+ scm_ichar_t val;
+ DECLARE_FUNCTION("char-upper-case?", procedure_fixed_1);
+
+ ENSURE_CHAR(ch);
+
+ val = SCM_CHAR_VALUE(ch);
+
+ return MAKE_BOOL(isascii(val) && isupper(val));
+}
+
+ScmObj
+scm_p_char_lower_casep(ScmObj ch)
+{
+ scm_ichar_t val;
+ DECLARE_FUNCTION("char-lower-case?", procedure_fixed_1);
+
+ ENSURE_CHAR(ch);
+
+ val = SCM_CHAR_VALUE(ch);
+
+ return MAKE_BOOL(isascii(val) && islower(val));
+}
+
+ScmObj
+scm_p_char2integer(ScmObj ch)
+{
+ DECLARE_FUNCTION("char->integer", procedure_fixed_1);
+
+ ENSURE_CHAR(ch);
+
+ return MAKE_INT(SCM_CHAR_VALUE(ch));
+}
+
+ScmObj
+scm_p_integer2char(ScmObj n)
+{
+ scm_int_t val;
+ DECLARE_FUNCTION("integer->char", procedure_fixed_1);
+
+ ENSURE_INT(n);
+
+ val = SCM_INT_VALUE(n);
+#if SCM_USE_MULTIBYTE_CHAR
+ if (!SCM_CHARCODEC_CHAR_LEN(scm_current_char_codec, val))
+#else
+ if (!isascii(val))
+#endif
+ ERR_OBJ("invalid char value", n);
+
+ return MAKE_CHAR(val);
+}
+
+ScmObj
+scm_p_char_upcase(ScmObj ch)
+{
+ scm_ichar_t val;
+ DECLARE_FUNCTION("char-upcase", procedure_fixed_1);
+
+ ENSURE_CHAR(ch);
+
+ val = SCM_CHAR_VALUE(ch);
+ SCM_CHAR_SET_VALUE(ch, ICHAR_UPCASE(val));
+
+ return ch;
+}
+
+ScmObj
+scm_p_char_downcase(ScmObj ch)
+{
+ scm_ichar_t val;
+ DECLARE_FUNCTION("char-downcase", procedure_fixed_1);
+
+ ENSURE_CHAR(ch);
+
+ val = SCM_CHAR_VALUE(ch);
+ SCM_CHAR_SET_VALUE(ch, ICHAR_DOWNCASE(val));
+
+ return ch;
+}
Modified: branches/r5rs/sigscheme/src/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/src/sigscheme.h 2006-02-02 10:17:05 UTC (rev 3075)
+++ branches/r5rs/sigscheme/src/sigscheme.h 2006-02-02 10:19:54 UTC (rev 3076)
@@ -1235,7 +1235,7 @@
ScmObj scm_p_number2string (ScmObj num, ScmObj args);
ScmObj scm_p_string2number(ScmObj str, ScmObj args);
-/* string.c */
+/* char.c */
ScmObj scm_p_charp(ScmObj obj);
ScmObj scm_p_char_equalp(ScmObj ch1, ScmObj ch2);
ScmObj scm_p_char_lessp(ScmObj ch1, ScmObj ch2);
@@ -1258,6 +1258,7 @@
ScmObj scm_p_char_upcase(ScmObj ch);
ScmObj scm_p_char_downcase(ScmObj ch);
+/* string.c */
ScmObj scm_p_stringp(ScmObj obj);
ScmObj scm_p_make_string(ScmObj length, ScmObj args);
ScmObj scm_p_string(ScmObj args);
Modified: branches/r5rs/sigscheme/src/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/src/sigschemeinternal.h 2006-02-02 10:17:05 UTC (rev 3075)
+++ branches/r5rs/sigscheme/src/sigschemeinternal.h 2006-02-02 10:19:54 UTC (rev 3076)
@@ -39,6 +39,7 @@
=======================================*/
#include <stddef.h>
#include <string.h>
+#include <ctype.h> /* for char macros */
/*=======================================
Local Include
@@ -425,6 +426,35 @@
#define SCM_LISTLEN_ENCODE_ERROR SCM_LISTLEN_ENCODE_CIRCULAR
/*=======================================
+ Characters
+=======================================*/
+/*
+ * SigScheme's case-insensitive comparison conforms to the foldcase'ed
+ * comparison described in SRFI-75 and SRFI-13, although R5RS does not specify
+ * comparison between alphabetic and non-alphabetic char.
+ *
+ * This specification is needed to produce natural result on sort functions
+ * with these case-insensitive predicates as comparator.
+ *
+ * (a-sort '(#\a #\c #\B #\D #\1 #\[ #\$ #\_) char-ci<?)
+ * => (#\$ #\1 #\a #\B #\c #\D #\[ #\_) ;; the "natural result"
+ *
+ * => (#\$ #\1 #\B #\D #\[ #\_ #\a #\c) ;; "unnatural result"
+ *
+ * See also:
+ *
+ * - Description around 'char-foldcase' in SRFI-75
+ * - "Case mapping and case-folding" and "Comparison" section of SRFI-13
+ */
+/* FIXME: support SRFI-75 */
+#define ICHAR_DOWNCASE(c) ((isascii((int)(c))) ? tolower((int)(c)) : (c))
+#define ICHAR_UPCASE(c) ((isascii((int)(c))) ? toupper((int)(c)) : (c))
+/* foldcase for case-insensitive character comparison is done by downcase as
+ * described in SRFI-75. Although SRFI-13 expects (char-downcase (char-upcase
+ * c)), this implementation is sufficient for ASCII range. */
+#define ICHAR_FOLDCASE(c) (ICHAR_DOWNCASE(c))
+
+/*=======================================
List Constructor
=======================================*/
typedef ScmRef ScmQueue;
Modified: branches/r5rs/sigscheme/src/string.c
===================================================================
--- branches/r5rs/sigscheme/src/string.c 2006-02-02 10:17:05 UTC (rev 3075)
+++ branches/r5rs/sigscheme/src/string.c 2006-02-02 10:19:54 UTC (rev 3076)
@@ -60,32 +60,6 @@
#define STRING_CI_CMP(str1, str2) \
(string_cmp(SCM_MANGLE(name), (str1), (str2), scm_true))
-/*
- * SigScheme's case-insensitive comparison conforms to the foldcase'ed
- * comparison described in SRFI-75 and SRFI-13, although R5RS does not specify
- * comparison between alphabetic and non-alphabetic char.
- *
- * This specification is needed to produce natural result on sort functions
- * with these case-insensitive predicates as comparator.
- *
- * (a-sort '(#\a #\c #\B #\D #\1 #\[ #\$ #\_) char-ci<?)
- * => (#\$ #\1 #\a #\B #\c #\D #\[ #\_) ;; the "natural result"
- *
- * => (#\$ #\1 #\B #\D #\[ #\_ #\a #\c) ;; "unnatural result"
- *
- * See also:
- *
- * - Description around 'char-foldcase' in SRFI-75
- * - "Case mapping and case-folding" and "Comparison" section of SRFI-13
- */
-/* FIXME: support SRFI-75 */
-#define ICHAR_DOWNCASE(c) ((isascii((int)(c))) ? tolower((int)(c)) : (c))
-#define ICHAR_UPCASE(c) ((isascii((int)(c))) ? toupper((int)(c)) : (c))
-/* foldcase for case-insensitive character comparison is done by downcase as
- * described in SRFI-75. Although SRFI-13 expects (char-downcase (char-upcase
- * c)), this implementation is sufficient for ASCII range. */
-#define ICHAR_FOLDCASE(c) (ICHAR_DOWNCASE(c))
-
/*=======================================
Variable Declarations
=======================================*/
@@ -102,252 +76,7 @@
/*=======================================
Function Implementations
=======================================*/
-
/*===========================================================================
- R5RS : 6.3 Other data types : 6.3.4 Characters
-===========================================================================*/
-ScmObj
-scm_p_charp(ScmObj obj)
-{
- DECLARE_FUNCTION("char?", procedure_fixed_1);
-
- return MAKE_BOOL(CHARP(obj));
-}
-
-ScmObj
-scm_p_char_equalp(ScmObj ch1, ScmObj ch2)
-{
- DECLARE_FUNCTION("char=?", procedure_fixed_2);
-
- ENSURE_CHAR(ch1);
- ENSURE_CHAR(ch2);
-
-#if SCM_HAS_IMMEDIATE_CHAR_ONLY
- return MAKE_BOOL(EQ(ch1, ch2));
-#else
- return MAKE_BOOL(SCM_CHAR_VALUE(ch1) == SCM_CHAR_VALUE(ch2));
-#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_FOLDCASE(SCM_CHAR_VALUE(ch1)); \
- val2 = ICHAR_FOLDCASE(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;
- DECLARE_FUNCTION("char-alphabetic?", procedure_fixed_1);
-
- ENSURE_CHAR(ch);
-
- val = SCM_CHAR_VALUE(ch);
-
- return MAKE_BOOL(isascii(val) && isalpha(val));
-}
-
-ScmObj
-scm_p_char_numericp(ScmObj ch)
-{
- scm_ichar_t val;
- DECLARE_FUNCTION("char-numeric?", procedure_fixed_1);
-
- ENSURE_CHAR(ch);
-
- val = SCM_CHAR_VALUE(ch);
-
- return MAKE_BOOL(isascii(val) && isdigit(val));
-}
-
-ScmObj
-scm_p_char_whitespacep(ScmObj ch)
-{
- scm_ichar_t val;
- DECLARE_FUNCTION("char-whitespace?", procedure_fixed_1);
-
- ENSURE_CHAR(ch);
-
- val = SCM_CHAR_VALUE(ch);
-
- return MAKE_BOOL(isascii(val) && isspace(val));
-}
-
-ScmObj
-scm_p_char_upper_casep(ScmObj ch)
-{
- scm_ichar_t val;
- DECLARE_FUNCTION("char-upper-case?", procedure_fixed_1);
-
- ENSURE_CHAR(ch);
-
- val = SCM_CHAR_VALUE(ch);
-
- return MAKE_BOOL(isascii(val) && isupper(val));
-}
-
-ScmObj
-scm_p_char_lower_casep(ScmObj ch)
-{
- scm_ichar_t val;
- DECLARE_FUNCTION("char-lower-case?", procedure_fixed_1);
-
- ENSURE_CHAR(ch);
-
- val = SCM_CHAR_VALUE(ch);
-
- return MAKE_BOOL(isascii(val) && islower(val));
-}
-
-ScmObj
-scm_p_char2integer(ScmObj ch)
-{
- DECLARE_FUNCTION("char->integer", procedure_fixed_1);
-
- ENSURE_CHAR(ch);
-
- return MAKE_INT(SCM_CHAR_VALUE(ch));
-}
-
-ScmObj
-scm_p_integer2char(ScmObj n)
-{
- scm_int_t val;
- DECLARE_FUNCTION("integer->char", procedure_fixed_1);
-
- ENSURE_INT(n);
-
- val = SCM_INT_VALUE(n);
-#if SCM_USE_MULTIBYTE_CHAR
- if (!SCM_CHARCODEC_CHAR_LEN(scm_current_char_codec, val))
-#else
- if (!isascii(val))
-#endif
- ERR_OBJ("invalid char value", n);
-
- return MAKE_CHAR(val);
-}
-
-ScmObj
-scm_p_char_upcase(ScmObj ch)
-{
- scm_ichar_t val;
- DECLARE_FUNCTION("char-upcase", procedure_fixed_1);
-
- ENSURE_CHAR(ch);
-
- val = SCM_CHAR_VALUE(ch);
- SCM_CHAR_SET_VALUE(ch, ICHAR_UPCASE(val));
-
- return ch;
-}
-
-ScmObj
-scm_p_char_downcase(ScmObj ch)
-{
- scm_ichar_t val;
- DECLARE_FUNCTION("char-downcase", procedure_fixed_1);
-
- ENSURE_CHAR(ch);
-
- val = SCM_CHAR_VALUE(ch);
- SCM_CHAR_SET_VALUE(ch, ICHAR_DOWNCASE(val));
-
- return ch;
-}
-
-/*===========================================================================
R5RS : 6.3 Other data types : 6.3.5 Strings
===========================================================================*/
ScmObj
More information about the uim-commit
mailing list