[uim-commit] r1602 - branches/r5rs/sigscheme
yamaken at freedesktop.org
yamaken at freedesktop.org
Mon Sep 26 19:17:29 PDT 2005
Author: yamaken
Date: 2005-09-26 19:17:25 -0700 (Mon, 26 Sep 2005)
New Revision: 1602
Modified:
branches/r5rs/sigscheme/TODO
branches/r5rs/sigscheme/operations-srfi60.c
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/sigscheme.h
Log:
* sigscheme/sigscheme.h
- (ScmOp_SRFI60_logand, ScmOp_SRFI60_logior, ScmOp_SRFI60_logxor):
Change function type to SCM_REDUCTION_OPERATOR
* sigscheme/operations-srfi60.c
- (BITWISE_OPERATION_BODY): New macro
- (ScmOp_SRFI60_logand, ScmOp_SRFI60_logior, ScmOp_SRFI60_logxor):
Rewrite as SCM_REDUCTION_OPERATOR
* sigscheme/sigscheme.c
- (SigScm_Initialize_internal):
* Follow above changes
* Replace obsolete function registration interface for SRFI-60
functions with new one
* sigscheme/TODO
- Update
Modified: branches/r5rs/sigscheme/TODO
===================================================================
--- branches/r5rs/sigscheme/TODO 2005-09-27 01:00:38 UTC (rev 1601)
+++ branches/r5rs/sigscheme/TODO 2005-09-27 02:17:25 UTC (rev 1602)
@@ -65,7 +65,6 @@
function and share it with ScmOp_apply()
* Withdraw SCM_REDUCE*() macro
- - Rewrite SRFI-60 procs as SCM_REDUCTION_OPERATOR function
* Reorganize SCM_SHIFT*() macros and simplify args extraction codes
Modified: branches/r5rs/sigscheme/operations-srfi60.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi60.c 2005-09-27 01:00:38 UTC (rev 1601)
+++ branches/r5rs/sigscheme/operations-srfi60.c 2005-09-27 02:17:25 UTC (rev 1602)
@@ -48,6 +48,28 @@
/*=======================================
File Local Macro Declarations
=======================================*/
+#define BITWISE_OPERATION_BODY(op, opstr) \
+ do { \
+ int result = 0; \
+ switch (*state) { \
+ case SCM_REDUCE_0: \
+ break; \
+ case SCM_REDUCE_1: \
+ if (!INTP(left)) \
+ SigScm_ErrorObj(opstr " : integer required but got ", left); \
+ return right; \
+ case SCM_REDUCE_PARTWAY: \
+ case SCM_REDUCE_LAST: \
+ /* left is already ensured as int by previous loop */ \
+ if (!INTP(right)) \
+ SigScm_ErrorObj(opstr " : integer required but got ", right); \
+ result = (SCM_INT_VALUE(left) op SCM_INT_VALUE(right)); \
+ break; \
+ default: \
+ SigScm_Error(opstr " : (internal error) unrecognized state specifier: %d\n", *state); \
+ } \
+ return Scm_NewInt(result); \
+ } while (/* CONSTCOND */ 0)
/*=======================================
Variable Declarations
@@ -66,29 +88,22 @@
=============================================================================*/
/* Bitwise Operations */
-
-/* FIXME: Rewrite as a SCM_REDUCTION_OPERATOR function */
-ScmObj ScmOp_SRFI60_logand(ScmObj args, ScmObj env)
+ScmObj ScmOp_SRFI60_logand(ScmObj left, ScmObj right,
+ enum ScmReductionState *state)
{
- SCM_REDUCE((accum & elm), 0, args, env,
- int, INTP, SCM_INT_VALUE, Scm_NewInt,
- "logand : integer required but got ");
+ BITWISE_OPERATION_BODY(&, "logand");
}
-/* FIXME: Rewrite as a SCM_REDUCTION_OPERATOR function */
-ScmObj ScmOp_SRFI60_logior(ScmObj args, ScmObj env)
+ScmObj ScmOp_SRFI60_logior(ScmObj left, ScmObj right,
+ enum ScmReductionState *state)
{
- SCM_REDUCE((accum | elm), 0, args, env,
- int, INTP, SCM_INT_VALUE, Scm_NewInt,
- "logior : integer required but got ");
+ BITWISE_OPERATION_BODY(|, "logand");
}
-/* FIXME: Rewrite as a SCM_REDUCTION_OPERATOR function */
-ScmObj ScmOp_SRFI60_logxor(ScmObj args, ScmObj env)
+ScmObj ScmOp_SRFI60_logxor(ScmObj left, ScmObj right,
+ enum ScmReductionState *state)
{
- SCM_REDUCE((accum ^ elm), 0, args, env,
- int, INTP, SCM_INT_VALUE, Scm_NewInt,
- "logxor : integer required but got ");
+ BITWISE_OPERATION_BODY(^, "logand");
}
ScmObj ScmOp_SRFI60_lognot(ScmObj n)
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2005-09-27 01:00:38 UTC (rev 1601)
+++ branches/r5rs/sigscheme/sigscheme.c 2005-09-27 02:17:25 UTC (rev 1602)
@@ -387,18 +387,18 @@
/*=======================================================================
SRFI-60 Procedures
=======================================================================*/
- Scm_RegisterFuncRawList("logand" , ScmOp_SRFI60_logand);
- Scm_RegisterFuncRawList("logior" , ScmOp_SRFI60_logior);
- Scm_RegisterFuncRawList("logxor" , ScmOp_SRFI60_logxor);
- Scm_RegisterFunc1("lognot" , ScmOp_SRFI60_lognot);
- Scm_RegisterFunc3("bitwise-if" , ScmOp_SRFI60_bitwise_if);
- Scm_RegisterFunc2("logtest" , ScmOp_SRFI60_logtest);
- Scm_DefineAlias("bitwise-and" , "logand");
- Scm_DefineAlias("bitwise-ior" , "logior");
- Scm_DefineAlias("bitwise-xor" , "logxor");
- Scm_DefineAlias("bitwise-not" , "lognot");
- Scm_DefineAlias("bitwise-merge" , "bitwise-if");
- Scm_DefineAlias("any-bits-set?" , "logtest");
+ Scm_RegisterReductionOperator("logand" , ScmOp_SRFI60_logand);
+ Scm_RegisterReductionOperator("logior" , ScmOp_SRFI60_logior);
+ Scm_RegisterReductionOperator("logxor" , ScmOp_SRFI60_logxor);
+ Scm_RegisterProcedureFixed1("lognot" , ScmOp_SRFI60_lognot);
+ Scm_RegisterProcedureFixed3("bitwise-if" , ScmOp_SRFI60_bitwise_if);
+ Scm_RegisterProcedureFixed2("logtest" , ScmOp_SRFI60_logtest);
+ Scm_DefineAlias("bitwise-and" , "logand");
+ Scm_DefineAlias("bitwise-ior" , "logior");
+ Scm_DefineAlias("bitwise-xor" , "logxor");
+ Scm_DefineAlias("bitwise-not" , "lognot");
+ Scm_DefineAlias("bitwise-merge" , "bitwise-if");
+ Scm_DefineAlias("any-bits-set?" , "logtest");
#endif
#if SCM_COMPAT_SIOD
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2005-09-27 01:00:38 UTC (rev 1601)
+++ branches/r5rs/sigscheme/sigscheme.h 2005-09-27 02:17:25 UTC (rev 1602)
@@ -868,9 +868,12 @@
#endif
#if SCM_USE_SRFI60
/* operations-srfi60.c */
-ScmObj ScmOp_SRFI60_logand(ScmObj args, ScmObj env);
-ScmObj ScmOp_SRFI60_logior(ScmObj args, ScmObj env);
-ScmObj ScmOp_SRFI60_logxor(ScmObj args, ScmObj env);
+ScmObj ScmOp_SRFI60_logand(ScmObj left, ScmObj right,
+ enum ScmReductionState *state);
+ScmObj ScmOp_SRFI60_logior(ScmObj left, ScmObj right,
+ enum ScmReductionState *state);
+ScmObj ScmOp_SRFI60_logxor(ScmObj left, ScmObj right,
+ enum ScmReductionState *state);
ScmObj ScmOp_SRFI60_lognot(ScmObj n);
ScmObj ScmOp_SRFI60_bitwise_if(ScmObj mask, ScmObj n0, ScmObj n1);
ScmObj ScmOp_SRFI60_logtest(ScmObj j, ScmObj k);
More information about the uim-commit
mailing list