[uim-commit] r1326 - branches/r5rs/sigscheme
kzk at freedesktop.org
kzk at freedesktop.org
Thu Aug 25 22:05:47 PDT 2005
Author: kzk
Date: 2005-08-25 22:05:45 -0700 (Thu, 25 Aug 2005)
New Revision: 1326
Added:
branches/r5rs/sigscheme/operations-siod.c
Modified:
branches/r5rs/sigscheme/eval.c
branches/r5rs/sigscheme/operations.c
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/sigscheme.h
Log:
* move SIOD compatible procs to operations-siod.c
* sigscheme/operations-siod.c
- new file
* sigscheme/eval.c
- (ScmOp_symbol_boundp, ScmOp_symbol_value,
ScmOp_set_symbol_value, ScmOp_bit_and,
ScmOp_bit_or, ScmOp_bit_xor, ScmOp_bit_not,
ScmOp_the_environment, ScmOp_closure_code)
: move to operations-siod.c
* sigscheme/sigscheme.c
- (SigScm_Initialize): comment update
* sigscheme/sigscheme.h
- move SIOD compatible declarations' place
- comment update
* sigscheme/operations.c
- include operations-siod.c if SCM_COMPAT_SIOD is defined as 1
Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c 2005-08-26 04:47:37 UTC (rev 1325)
+++ branches/r5rs/sigscheme/eval.c 2005-08-26 05:05:45 UTC (rev 1326)
@@ -1665,89 +1665,3 @@
{
return SCM_NULL;
}
-
-#if SCM_COMPAT_SIOD
-/*=======================================
- SIOD compatible procedures
-
- TODO : remove these functions!
-=======================================*/
-ScmObj ScmOp_symbol_boundp(ScmObj obj)
-{
- if (SYMBOLP(obj)
- && !EQ(SCM_SYMBOL_VCELL(obj), SCM_UNBOUND))
- {
- return SCM_TRUE;
- }
-
- return SCM_FALSE;
-}
-
-ScmObj ScmOp_symbol_value(ScmObj var)
-{
- if (!SYMBOLP(var))
- SigScm_ErrorObj("symbol-value : require symbol but got ", var);
-
- return symbol_value(var, SCM_NULL);
-}
-
-ScmObj ScmOp_set_symbol_value(ScmObj var, ScmObj val)
-{
- /* sanity check */
- if (!SYMBOLP(var))
- SigScm_ErrorObj("set-symbol-value! : require symbol but got ", var);
-
- return SCM_SYMBOL_SET_VCELL(var, val);
-}
-
-ScmObj ScmOp_bit_and(ScmObj obj1, ScmObj obj2)
-{
- if (!INTP(obj1))
- SigScm_ErrorObj("bit-and : number required but got ", obj1);
- if (!INTP(obj2))
- SigScm_ErrorObj("bit-and : number required but got ", obj2);
-
- return Scm_NewInt(SCM_INT_VALUE(obj1) & SCM_INT_VALUE(obj2));
-}
-
-ScmObj ScmOp_bit_or(ScmObj obj1, ScmObj obj2)
-{
- if (!INTP(obj1))
- SigScm_ErrorObj("bit-or : number required but got ", obj1);
- if (!INTP(obj2))
- SigScm_ErrorObj("bit-or : number required but got ", obj2);
-
- return Scm_NewInt(SCM_INT_VALUE(obj1) | SCM_INT_VALUE(obj2));
-}
-
-ScmObj ScmOp_bit_xor(ScmObj obj1, ScmObj obj2)
-{
- if (!INTP(obj1))
- SigScm_ErrorObj("bit-xor : number required but got ", obj1);
- if (!INTP(obj2))
- SigScm_ErrorObj("bit-xor : number required but got ", obj2);
-
- return Scm_NewInt(SCM_INT_VALUE(obj1) ^ SCM_INT_VALUE(obj2));
-}
-
-ScmObj ScmOp_bit_not(ScmObj obj)
-{
- if (!INTP(obj))
- SigScm_ErrorObj("bit-not : number required but got ", obj);
-
- return Scm_NewInt(~SCM_INT_VALUE(obj));
-}
-
-ScmObj ScmOp_the_environment(ScmObj arg, ScmObj env)
-{
- return env;
-}
-
-ScmObj ScmOp_closure_code(ScmObj closure)
-{
- if (!CLOSUREP(closure))
- SigScm_ErrorObj("%%closure-code : closure required but got ", closure);
-
- return SCM_CLOSURE_EXP(closure);
-}
-#endif
Added: branches/r5rs/sigscheme/operations-siod.c
===================================================================
--- branches/r5rs/sigscheme/operations-siod.c 2005-08-26 04:47:37 UTC (rev 1325)
+++ branches/r5rs/sigscheme/operations-siod.c 2005-08-26 05:05:45 UTC (rev 1326)
@@ -0,0 +1,145 @@
+/*===========================================================================
+ * FileName : operations-siod.c
+ * About : SIOD compatible procedures
+ *
+ * Copyright (C) 2005 by 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.
+===========================================================================*/
+/*=======================================
+ System Include
+=======================================*/
+#include "sigscheme.h"
+#include "sigschemeinternal.h"
+
+/*=======================================
+ Local Include
+=======================================*/
+
+/*=======================================
+ File Local Struct Declarations
+=======================================*/
+
+/*=======================================
+ File Local Macro Declarations
+=======================================*/
+
+/*=======================================
+ Variable Declarations
+=======================================*/
+
+/*=======================================
+ File Local Function Declarations
+=======================================*/
+
+/*=======================================
+ Function Implementations
+=======================================*/
+/*=======================================
+ SIOD compatible procedures
+
+ TODO : remove these functions!
+=======================================*/
+ScmObj ScmOp_symbol_boundp(ScmObj obj)
+{
+ if (SYMBOLP(obj)
+ && !EQ(SCM_SYMBOL_VCELL(obj), SCM_UNBOUND))
+ {
+ return SCM_TRUE;
+ }
+
+ return SCM_FALSE;
+}
+
+ScmObj ScmOp_symbol_value(ScmObj var)
+{
+ if (!SYMBOLP(var))
+ SigScm_ErrorObj("symbol-value : require symbol but got ", var);
+
+ return symbol_value(var, SCM_NULL);
+}
+
+ScmObj ScmOp_set_symbol_value(ScmObj var, ScmObj val)
+{
+ /* sanity check */
+ if (!SYMBOLP(var))
+ SigScm_ErrorObj("set-symbol-value! : require symbol but got ", var);
+
+ return SCM_SYMBOL_SET_VCELL(var, val);
+}
+
+ScmObj ScmOp_bit_and(ScmObj obj1, ScmObj obj2)
+{
+ if (!INTP(obj1))
+ SigScm_ErrorObj("bit-and : number required but got ", obj1);
+ if (!INTP(obj2))
+ SigScm_ErrorObj("bit-and : number required but got ", obj2);
+
+ return Scm_NewInt(SCM_INT_VALUE(obj1) & SCM_INT_VALUE(obj2));
+}
+
+ScmObj ScmOp_bit_or(ScmObj obj1, ScmObj obj2)
+{
+ if (!INTP(obj1))
+ SigScm_ErrorObj("bit-or : number required but got ", obj1);
+ if (!INTP(obj2))
+ SigScm_ErrorObj("bit-or : number required but got ", obj2);
+
+ return Scm_NewInt(SCM_INT_VALUE(obj1) | SCM_INT_VALUE(obj2));
+}
+
+ScmObj ScmOp_bit_xor(ScmObj obj1, ScmObj obj2)
+{
+ if (!INTP(obj1))
+ SigScm_ErrorObj("bit-xor : number required but got ", obj1);
+ if (!INTP(obj2))
+ SigScm_ErrorObj("bit-xor : number required but got ", obj2);
+
+ return Scm_NewInt(SCM_INT_VALUE(obj1) ^ SCM_INT_VALUE(obj2));
+}
+
+ScmObj ScmOp_bit_not(ScmObj obj)
+{
+ if (!INTP(obj))
+ SigScm_ErrorObj("bit-not : number required but got ", obj);
+
+ return Scm_NewInt(~SCM_INT_VALUE(obj));
+}
+
+ScmObj ScmOp_the_environment(ScmObj arg, ScmObj env)
+{
+ return env;
+}
+
+ScmObj ScmOp_closure_code(ScmObj closure)
+{
+ if (!CLOSUREP(closure))
+ SigScm_ErrorObj("%%closure-code : closure required but got ", closure);
+
+ return SCM_CLOSURE_EXP(closure);
+}
Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c 2005-08-26 04:47:37 UTC (rev 1325)
+++ branches/r5rs/sigscheme/operations.c 2005-08-26 05:05:45 UTC (rev 1326)
@@ -2029,3 +2029,6 @@
#if SCM_USE_SRFI8
#include "operations-srfi8.c"
#endif
+#if SCM_COMPAT_SIOD
+#include "operations-siod.c"
+#endif
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2005-08-26 04:47:37 UTC (rev 1325)
+++ branches/r5rs/sigscheme/sigscheme.c 2005-08-26 05:05:45 UTC (rev 1326)
@@ -326,7 +326,7 @@
/*=======================================================================
SIOD Compatible Variables and Procedures
=======================================================================*/
- /* eval.c */
+ /* operations-siod.c */
Scm_RegisterFunc1("symbol-bound?" , ScmOp_symbol_boundp);
Scm_RegisterFunc1("symbol-value" , ScmOp_symbol_value);
Scm_RegisterFunc2("set-symbol-value!" , ScmOp_set_symbol_value);
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2005-08-26 04:47:37 UTC (rev 1325)
+++ branches/r5rs/sigscheme/sigscheme.h 2005-08-26 05:05:45 UTC (rev 1326)
@@ -55,7 +55,7 @@
=======================================*/
typedef void (*C_FUNC) (void);
-/* type declaration */
+/* type declaration */
#include "sigschemetype.h"
/*=======================================
@@ -153,18 +153,6 @@
ScmObj ScmExp_define(ScmObj arg, ScmObj *envp, int *tail_flag);
ScmObj ScmOp_scheme_report_environment(ScmObj version);
ScmObj ScmOp_null_environment(ScmObj version);
-#if SCM_COMPAT_SIOD
-/* SIOD compatible functions */
-ScmObj ScmOp_symbol_boundp(ScmObj obj);
-ScmObj ScmOp_symbol_value(ScmObj var);
-ScmObj ScmOp_set_symbol_value(ScmObj var, ScmObj val);
-ScmObj ScmOp_bit_and(ScmObj obj1, ScmObj obj2);
-ScmObj ScmOp_bit_or(ScmObj obj1, ScmObj obj2);
-ScmObj ScmOp_bit_xor(ScmObj obj1, ScmObj obj2);
-ScmObj ScmOp_bit_not(ScmObj obj);
-ScmObj ScmOp_the_environment(ScmObj arg, ScmObj env);
-ScmObj ScmOp_closure_code(ScmObj closure);
-#endif
/* operations.c */
ScmObj ScmOp_eqvp(ScmObj obj1, ScmObj obj2);
@@ -349,6 +337,7 @@
void SigScm_DisplayToPort(ScmObj port, ScmObj obj);
#if SCM_USE_SRFI1
+/* operations-srfi1.c */
ScmObj ScmOp_SRFI1_xcons(ScmObj a, ScmObj b);
ScmObj ScmOp_SRFI1_cons_star(ScmObj obj, ScmObj env);
ScmObj ScmOp_SRFI1_make_list(ScmObj obj, ScmObj env);
@@ -358,8 +347,21 @@
ScmObj ScmOp_SRFI1_iota(ScmObj args, ScmObj env);
#endif
#if SCM_USE_SRFI8
+/* operations-srfi8.c */
ScmObj ScmOp_SRFI8_receive(ScmObj args, ScmObj *envp, int *tail_flag);
#endif
+#if SCM_COMPAT_SIOD
+/* operations-siod.c */
+ScmObj ScmOp_symbol_boundp(ScmObj obj);
+ScmObj ScmOp_symbol_value(ScmObj var);
+ScmObj ScmOp_set_symbol_value(ScmObj var, ScmObj val);
+ScmObj ScmOp_bit_and(ScmObj obj1, ScmObj obj2);
+ScmObj ScmOp_bit_or(ScmObj obj1, ScmObj obj2);
+ScmObj ScmOp_bit_xor(ScmObj obj1, ScmObj obj2);
+ScmObj ScmOp_bit_not(ScmObj obj);
+ScmObj ScmOp_the_environment(ScmObj arg, ScmObj env);
+ScmObj ScmOp_closure_code(ScmObj closure);
+#endif
#ifdef __cplusplus
}
More information about the uim-commit
mailing list