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

[yamaken at freedesktop.org]

Author: yamaken
Date: 2005-09-04 22:49:13 -0700 (Sun, 04 Sep 2005)
New Revision: 1423

Modified:
   branches/r5rs/sigscheme/operations-srfi60.c
   branches/r5rs/sigscheme/sigschemeinternal.h
Log:
* This commit extends the SCM_REDUCE macro once more.

  TODO: Simplify implementation of following functions with SCM_REDUCE
  and SCM_REDUCE_EXT. Anyone?

  - ScmOp_add, ScmOp_multiply, ScmOp_subtract, ScmOp_divide,
    ScmOp_equal, ScmOp_less, ScmOp_greater, ScmOp_less_eq,
    ScmOp_greater_eq, ScmOp_max, ScmOp_min

* sigscheme/sigschemeinternal.h
  - (SCM_REDUCE): Replace with SCM_REDUCE_EXT invocation with some
    predefined arguments
  - (SCM_REDUCE_EXT):
    * New macro
    * Inherit previous implementation of SCM_REDUCE and make more
      generic to be able to handle wider situations
* sigscheme/operations-srfi60.c
  - (ScmOp_SRFI60_logand, ScmOp_SRFI60_logior, ScmOp_SRFI60_logxor):
    Follow the changes of argument names of 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 05:40:33 UTC (rev 1422)
+++ branches/r5rs/sigscheme/operations-srfi60.c	2005-09-05 05:49:13 UTC (rev 1423)
@@ -68,21 +68,21 @@
 /* Bitwise Operations */
 ScmObj ScmOp_SRFI60_logand(ScmObj args, ScmObj env)
 {
-    SCM_REDUCE((lhs & rhs), 0, args, env,
+    SCM_REDUCE((accum & elm), 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((lhs | rhs), 0, args, env,
+    SCM_REDUCE((accum | elm), 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((lhs ^ rhs), 0, args, env,
+    SCM_REDUCE((accum ^ elm), 0, args, env,
                int, INTP, SCM_INT_VALUE, Scm_NewInt,
                "logxor : integer required but got ");
 }

Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h	2005-09-05 05:40:33 UTC (rev 1422)
+++ branches/r5rs/sigscheme/sigschemeinternal.h	2005-09-05 05:49:13 UTC (rev 1423)
@@ -157,41 +157,56 @@
 #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))))
 
+/*
+ * TODO: Simplify implementation of following functions with SCM_REDUCE and
+ * SCM_REDUCE_EXT. Anyone?
+ *
+ * - ScmOp_add, ScmOp_multiply, ScmOp_subtract, ScmOp_divide, ScmOp_equal,
+ *   ScmOp_less, ScmOp_greater, ScmOp_less_eq, ScmOp_greater_eq, ScmOp_max,
+ *   ScmOp_min
+ */
 #define SCM_REDUCE(fexp, ridentity, lst, env,                                \
                    ctype, validp, extract, make, err_header)                 \
+    SCM_REDUCE_EXT((accum = (fexp)), ridentity, lst, env,                    \
+                   ctype, validp, extract, make,                             \
+                   (make(ridentity)), scm_elm, err_header)
+
+#define SCM_REDUCE_EXT(loop_exp, ridentity, lst, env,                        \
+                       ctype, validp, extract, make,                         \
+                       res0, res1, err_header)                               \
     do {                                                                     \
-        ScmObj elm, rest;                                                    \
-        ctype lhs, rhs;                                                      \
+        ScmObj scm_elm, rest;                                                \
+        ctype elm, accum;                                                    \
                                                                              \
         /* 0 */                                                              \
         if (NULLP(lst)) {                                                    \
-            return make(ridentity);                                          \
+            return (res0);                                                   \
         }                                                                    \
                                                                              \
         /* 1 */                                                              \
-        elm = ScmOp_eval(CAR(lst), env);                                     \
-        if (!validp(elm)) {                                                  \
-            SigScm_ErrorObj(err_header, elm);                                \
+        scm_elm = ScmOp_eval(CAR(lst), env);                                 \
+        accum = elm = extract(scm_elm);                                      \
+        if (!validp(scm_elm)) {                                              \
+            SigScm_ErrorObj(err_header, scm_elm);                            \
             return SCM_FALSE;                                                \
         } else if (NULLP(CDR(lst))) {                                        \
-            return elm;                                                      \
+            return (res1);                                                   \
         }                                                                    \
                                                                              \
         /* 2+ */                                                             \
-        rhs = extract(elm);                                                  \
         rest = CDR(lst);                                                     \
         do {                                                                 \
-            elm = ScmOp_eval(CAR(rest), env);                                \
+            scm_elm = ScmOp_eval(CAR(rest), env);                            \
             rest = CDR(rest);                                                \
-            if (!validp(elm)) {                                              \
-                SigScm_ErrorObj(err_header, elm);                            \
+            if (!validp(scm_elm)) {                                          \
+                SigScm_ErrorObj(err_header, scm_elm);                        \
                 return SCM_FALSE;                                            \
             }                                                                \
-            lhs = extract(elm);                                              \
-            rhs = (fexp);                                                    \
+            elm = extract(scm_elm);                                          \
+            (loop_exp);                                                      \
         } while (!NULLP(rest));                                              \
                                                                              \
-        return make(rhs);                                                    \
+        return make(accum);                                                  \
     } while (/* CONSTCOND */ 0)
 
 /*=======================================