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

[yamaken at freedesktop.org]

Author: yamaken
Date: 2006-01-08 23:18:14 -0800 (Sun, 08 Jan 2006)
New Revision: 2860

Modified:
   branches/r5rs/sigscheme/eval.c
   branches/r5rs/sigscheme/operations.c
   branches/r5rs/sigscheme/sigschemeinternal.h
   branches/r5rs/sigscheme/syntax.c
Log:
* sigscheme/sigschemeinternal.h
  - (FOR_EACH_BUTLAST): New macro
* sigscheme/eval.c
  - (reduce, scm_p_apply): Simplify with FOR_EACH_BUTLAST()
* sigscheme/syntax.c
  - (scm_s_and, scm_s_or, scm_s_begin): Ditto
* sigscheme/operations.c
  - (scm_p_append): Ditto
  - (scm_p_reverse):
    * Simplify with FOR_EACH
    * Remove ENSURE_PROPER_LIST_TERMINATION() since it had been made
      uneeded by the recent changes


Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c	2006-01-08 13:59:15 UTC (rev 2859)
+++ branches/r5rs/sigscheme/eval.c	2006-01-09 07:18:14 UTC (rev 2860)
@@ -160,14 +160,13 @@
 
     /* Reduce upto the penult. */
     state = SCM_REDUCE_PARTWAY;
-    FOR_EACH_WHILE (right, args, CONSP(CDR(args))) {
+    FOR_EACH_BUTLAST(right, args) {
         if (!suppress_eval)
             right = EVAL(right, env);
         left = (*func)(left, right, &state);
         if (state == SCM_REDUCE_STOP)
             return left;
     }
-    right = POP(args);
     ASSERT_NO_MORE_ARG(args);
 
     /* Make the last call. */
@@ -450,10 +449,9 @@
         /* More than one argument given. */
         args = LIST_1(arg0);
         q = REF_CDR(args);
-        FOR_EACH_WHILE (arg, rest, CONSP(CDR(rest)))
+        FOR_EACH_BUTLAST (arg, rest)
             SCM_QUEUE_ADD(q, arg);
         /* The last one is spliced. */
-        arg = POP(rest);
         SCM_QUEUE_SLOPPY_APPEND(q, arg);
         last = arg;
     }

Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c	2006-01-08 13:59:15 UTC (rev 2859)
+++ branches/r5rs/sigscheme/operations.c	2006-01-09 07:18:14 UTC (rev 2860)
@@ -898,7 +898,7 @@
 scm_p_append(ScmObj args)
 {
     ScmQueue q;
-    ScmObj elm_lst, res, tmp;
+    ScmObj lst, elm, res;
     DECLARE_FUNCTION("append", procedure_variadic_0);
 
     if (NULLP(args))
@@ -907,14 +907,13 @@
     res = SCM_NULL;
     SCM_QUEUE_POINT_TO(q, res);
     /* duplicate and merge all but the last argument */
-    FOR_EACH_WHILE (elm_lst, args, CONSP(CDR(args))) {
-        FOR_EACH (tmp, elm_lst)
-            SCM_QUEUE_ADD(q, tmp);
-        ENSURE_PROPER_LIST_TERMINATION(elm_lst, args);
+    FOR_EACH_BUTLAST (lst, args) {
+        FOR_EACH (elm, lst)
+            SCM_QUEUE_ADD(q, elm);
+        ENSURE_PROPER_LIST_TERMINATION(lst, args);
     }
-    tmp = POP(args);
     /* append the last argument */
-    SCM_QUEUE_SLOPPY_APPEND(q, tmp);
+    SCM_QUEUE_SLOPPY_APPEND(q, lst);
 
     return res;
 }
@@ -922,14 +921,13 @@
 ScmObj
 scm_p_reverse(ScmObj lst)
 {
-    ScmObj ret, rest;
+    ScmObj ret, elm;
     DECLARE_FUNCTION("reverse", procedure_fixed_1);
 
-    for (ret = SCM_NULL, rest = lst; CONSP(rest); rest = CDR(rest))
-        ret = CONS(CAR(rest), ret);
+    ret = SCM_NULL;
+    FOR_EACH (elm, lst)
+        ret = CONS(elm, ret);
 
-    ENSURE_PROPER_LIST_TERMINATION(rest, lst);
-
     return ret;
 }
 

Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h	2006-01-08 13:59:15 UTC (rev 2859)
+++ branches/r5rs/sigscheme/sigschemeinternal.h	2006-01-09 07:18:14 UTC (rev 2860)
@@ -315,6 +315,16 @@
 #define FOR_EACH_PAIR(_subls, _lst)                                     \
     for ((_subls) = (_lst); CONSP((_subls)); (_subls) = CDR(_subls))
 
+/*
+ * - expression part for the syntax is evaluated for each element except for
+ *   the last one
+ * - _elm holds the last element after an overall iteration
+ * - _lst holds the terminal cdr after an overall iteration
+ */
+#define FOR_EACH_BUTLAST(_elm, _lst)                                         \
+    SCM_ASSERT(CONSP(_lst));                                                 \
+    while ((_elm) = POP(_lst), CONSP(_lst))
+
 #define ENSURE_TYPE(pred, typename, obj)                                     \
     (pred(obj) || (ERR_OBJ(typename " required but got", (obj)), 1))
 

Modified: branches/r5rs/sigscheme/syntax.c
===================================================================
--- branches/r5rs/sigscheme/syntax.c	2006-01-08 13:59:15 UTC (rev 2859)
+++ branches/r5rs/sigscheme/syntax.c	2006-01-09 07:18:14 UTC (rev 2860)
@@ -582,7 +582,7 @@
     if (NO_MORE_ARG(args))
         return SCM_TRUE;
 
-    FOR_EACH_WHILE (expr, args, CONSP(CDR(args))) {
+    FOR_EACH_BUTLAST (expr, args) {
         val = EVAL(expr, eval_state->env);
         if (FALSEP(val)) {
             ASSERT_PROPER_ARG_LIST(args);
@@ -590,7 +590,6 @@
             return SCM_FALSE;
         }
     }
-    expr = POP(args);
     ASSERT_NO_MORE_ARG(args);
 
     return expr;
@@ -605,7 +604,7 @@
     if (NO_MORE_ARG(args))
         return SCM_FALSE;
 
-    FOR_EACH_WHILE (expr, args, CONSP(CDR(args))) {
+    FOR_EACH_BUTLAST (expr, args) {
         val = EVAL(expr, eval_state->env);
         if (!FALSEP(val)) {
             ASSERT_PROPER_ARG_LIST(args);
@@ -613,7 +612,6 @@
             return val;
         }
     }
-    expr = POP(args);
     ASSERT_NO_MORE_ARG(args);
 
     return expr;
@@ -814,9 +812,8 @@
     if (NO_MORE_ARG(args))
         return SCM_UNDEF;
 
-    FOR_EACH_WHILE(expr, args, CONSP(CDR(args)))
+    FOR_EACH_BUTLAST (expr, args)
         EVAL(expr, eval_state->env);
-    expr = POP(args);
     ASSERT_NO_MORE_ARG(args);
 
     /* Return tail expression. */