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

[yamaken at freedesktop.org]

Author: yamaken
Date: 2006-01-08 04:38:19 -0800 (Sun, 08 Jan 2006)
New Revision: 2857

Modified:
   branches/r5rs/sigscheme/eval.c
   branches/r5rs/sigscheme/operations-nonstd.c
   branches/r5rs/sigscheme/operations-siod.c
   branches/r5rs/sigscheme/syntax.c
Log:
* sigscheme/operations-nonstd.c
  - (scm_p_symbol_boundp): Add termination check for args
* sigscheme/operations-siod.c
  - (scm_p_verbose): Ditto
* sigscheme/syntax.c
  - (scm_s_cond_internal): Ditto
  - (scm_s_or): Fix double eval for tail enbuged in r2832
* sigscheme/eval.c
  - (reduce):
    * Resurrect strict termination check for args
    * Remove redundant code fragment
  - (scm_p_apply): Add termination check for args


Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c	2006-01-08 10:59:03 UTC (rev 2856)
+++ branches/r5rs/sigscheme/eval.c	2006-01-08 12:38:19 UTC (rev 2857)
@@ -144,17 +144,16 @@
     enum ScmReductionState state;
     DECLARE_INTERNAL_FUNCTION("(reduction)");
 
-    if (!CONSP(args)) {
+    if (NO_MORE_ARG(args)) {
         state = SCM_REDUCE_0;
         return (*func)(SCM_INVALID, SCM_INVALID, &state);
     }
 
-    state = SCM_REDUCE_1;
     left = POP(args);
     if (!suppress_eval)
         left = EVAL(left, env);
 
-    if (!CONSP(args)) {
+    if (NO_MORE_ARG(args)) {
         state = SCM_REDUCE_1;
         return (*func)(left, left, &state);
     }
@@ -168,10 +167,11 @@
         if (state == SCM_REDUCE_STOP)
             return left;
     }
+    right = POP(args);
+    ASSERT_NO_MORE_ARG(args);
 
     /* Make the last call. */
     state = SCM_REDUCE_LAST;
-    right = CAR(args);
     if (!suppress_eval)
         right = EVAL(right, env);
     return (*func)(left, right, &state);
@@ -444,7 +444,7 @@
     ScmObj args, arg, last;
     DECLARE_FUNCTION("apply", procedure_variadic_tailrec_2);
 
-    if (NULLP(rest)) {
+    if (NO_MORE_ARG(rest)) {
         args = last = arg0;
     } else {
         /* More than one argument given. */

Modified: branches/r5rs/sigscheme/operations-nonstd.c
===================================================================
--- branches/r5rs/sigscheme/operations-nonstd.c	2006-01-08 10:59:03 UTC (rev 2856)
+++ branches/r5rs/sigscheme/operations-nonstd.c	2006-01-08 12:38:19 UTC (rev 2857)
@@ -95,6 +95,7 @@
 
     if (CONSP(rest)) {
         env = POP(rest);
+        ASSERT_NO_MORE_ARG(rest);
         ENSURE_VALID_ENV(env);
     } else {
         env = SCM_INTERACTION_ENV;

Modified: branches/r5rs/sigscheme/operations-siod.c
===================================================================
--- branches/r5rs/sigscheme/operations-siod.c	2006-01-08 10:59:03 UTC (rev 2856)
+++ branches/r5rs/sigscheme/operations-siod.c	2006-01-08 12:38:19 UTC (rev 2857)
@@ -204,6 +204,7 @@
 
     if (CONSP(args)) {
         level = POP(args);
+        ASSERT_NO_MORE_ARG(args);
         ENSURE_INT(level);
 
         scm_set_verbose_level(SCM_INT_VALUE(level));

Modified: branches/r5rs/sigscheme/syntax.c
===================================================================
--- branches/r5rs/sigscheme/syntax.c	2006-01-08 10:59:03 UTC (rev 2856)
+++ branches/r5rs/sigscheme/syntax.c	2006-01-08 12:38:19 UTC (rev 2857)
@@ -543,6 +543,7 @@
             return scm_s_begin(exps, eval_state);
         }
     }
+    NO_MORE_ARG(args);
 
     /*
      * To distinguish unmatched status from SCM_UNDEF from a clause, pure
@@ -604,7 +605,7 @@
     if (NO_MORE_ARG(args))
         return SCM_FALSE;
 
-    FOR_EACH (expr, args) {
+    FOR_EACH_WHILE (expr, args, CONSP(CDR(args))) {
         val = EVAL(expr, eval_state->env);
         if (!FALSEP(val)) {
             ASSERT_PROPER_ARG_LIST(args);
@@ -612,6 +613,8 @@
             return val;
         }
     }
+    expr = POP(args);
+    ASSERT_NO_MORE_ARG(args);
 
     return expr;
 }
@@ -813,9 +816,7 @@
 
     FOR_EACH_WHILE(expr, args, CONSP(CDR(args)))
         EVAL(expr, eval_state->env);
-
     expr = POP(args);
-
     ASSERT_NO_MORE_ARG(args);
 
     /* Return tail expression. */