[uim-commit] r1420 - branches/r5rs/sigscheme

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-09-04 20:57:13 -0700 (Sun, 04 Sep 2005)
New Revision: 1420

Modified:
   branches/r5rs/sigscheme/operations-srfi60.c
   branches/r5rs/sigscheme/sigschemeinternal.h
Log:
* sigscheme/sigschemeinternal.h
  - (SCM_REDUCE_BY_BINOP, SCM_REDUCE_BY_FUNC): Removed
  - (SCM_REDUCE_INTERNAL): Rename to SCM_REDUCE
  - (SCM_REDUCE):
    * Renamed from SCM_REDUCE_INTERNAL
    * Make generic to accept any C expression as f
* sigscheme/operations-srfi60.c
  - (ScmOp_SRFI60_logand, ScmOp_SRFI60_logior, ScmOp_SRFI60_logxor):
    Replace SCM_REDUCE_BY_BINOP with SCM_REDUCE
  - All tests for SRFI-60 have passed


Modified: branches/r5rs/sigscheme/operations-srfi60.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi60.c	2005-09-05 03:53:09 UTC (rev 1419)
+++ branches/r5rs/sigscheme/operations-srfi60.c	2005-09-05 03:57:13 UTC (rev 1420)
@@ -68,23 +68,23 @@
 /* Bitwise Operations */
 ScmObj ScmOp_SRFI60_logand(ScmObj args, ScmObj env)
 {
-    SCM_REDUCE_BY_BINOP(&, 0, args, env,
-                        int, INTP, SCM_INT_VALUE, Scm_NewInt,
-                        "logand : integer required but got ");
+    SCM_REDUCE((lhs & rhs), 0, args, env,
+               int, INTP, SCM_INT_VALUE, Scm_NewInt,
+               "logand : integer required but got ");
 }
 
 ScmObj ScmOp_SRFI60_logior(ScmObj args, ScmObj env)
 {
-    SCM_REDUCE_BY_BINOP(|, 0, args, env,
-                        int, INTP, SCM_INT_VALUE, Scm_NewInt,
-                        "logior : integer required but got ");
+    SCM_REDUCE((lhs | rhs), 0, args, env,
+               int, INTP, SCM_INT_VALUE, Scm_NewInt,
+               "logior : integer required but got ");
 }
 
 ScmObj ScmOp_SRFI60_logxor(ScmObj args, ScmObj env)
 {
-    SCM_REDUCE_BY_BINOP(^, 0, args, env,
-                        int, INTP, SCM_INT_VALUE, Scm_NewInt,
-                        "logxor : integer required but got ");
+    SCM_REDUCE((lhs ^ rhs), 0, args, env,
+               int, INTP, SCM_INT_VALUE, Scm_NewInt,
+               "logxor : integer required but got ");
 }
 
 ScmObj ScmOp_SRFI60_lognot(ScmObj n)

Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h	2005-09-05 03:53:09 UTC (rev 1419)
+++ branches/r5rs/sigscheme/sigschemeinternal.h	2005-09-05 03:57:13 UTC (rev 1420)
@@ -157,21 +157,11 @@
 #define CHECK_4_ARGS(arg) (CHECK_3_ARGS(arg) || NULLP(CDR(CDDR(arg))))
 #define CHECK_5_ARGS(arg) (CHECK_4_ARGS(arg) || NULLP(CDDR(CDDR(arg))))
 
-#define SCM_REDUCE_BY_BINOP(op, ridentity, lst, env,                         \
-                            ctype, validp, extract, make, err_header)        \
-    SCM_REDUCE_INTERNAL(((extract(elm)) op accum), ridentity, lst, env,      \
-                        ctype, validp, extract, make, err_header)
-
-#define SCM_REDUCE_BY_FUNC(f, ridentity, lst, env,                           \
-                           ctype, validp, extract, make, err_header)         \
-    SCM_REDUCE_INTERNAL(f(extract(elm), accum), ridentity, lst, env,         \
-                        ctype, validp, extract, make, err_header)
-
-#define SCM_REDUCE_INTERNAL(fexp, ridentity, lst, env,                       \
-                            ctype, validp, extract, make, err_header)        \
+#define SCM_REDUCE(fexp, ridentity, lst, env,                                \
+                   ctype, validp, extract, make, err_header)                 \
     do {                                                                     \
         ScmObj elm, rest;                                                    \
-        ctype accum;                                                         \
+        ctype lhs, rhs;                                                      \
                                                                              \
         /* 0 */                                                              \
         if (NULLP(lst)) {                                                    \
@@ -188,7 +178,7 @@
         }                                                                    \
                                                                              \
         /* 2+ */                                                             \
-        accum = extract(elm);                                                \
+        rhs = extract(elm);                                                  \
         rest = CDR(lst);                                                     \
         do {                                                                 \
             elm = ScmOp_eval(CAR(rest), env);                                \
@@ -197,10 +187,11 @@
                 SigScm_ErrorObj(err_header, elm);                            \
                 return SCM_FALSE;                                            \
             }                                                                \
-            accum = fexp;                                                    \
+            lhs = extract(elm);                                              \
+            rhs = (fexp);                                                    \
         } while (!NULLP(rest));                                              \
                                                                              \
-        return make(accum);                                                  \
+        return make(rhs);                                                    \
     } while (/* CONSTCOND */ 0)
 
 /*=======================================