[uim-commit] r1108 - in branches/r5rs/sigscheme: . test

[kzk at freedesktop.org]

Author: kzk
Date: 2005-08-02 13:35:54 -0700 (Tue, 02 Aug 2005)
New Revision: 1108

Modified:
   branches/r5rs/sigscheme/eval.c
   branches/r5rs/sigscheme/test/test-exp.scm
Log:
* fix "do" behavior

* sigscheme/eval.c
  - (ScmOp_do): each <step>s' execution result must not depend on
    each other. so we need to allocate new space for storing each
    results and set it by hand.

* sigscheme/test/test-exp.scm
  - add testcase for "do"


Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c	2005-08-02 19:12:23 UTC (rev 1107)
+++ branches/r5rs/sigscheme/eval.c	2005-08-02 20:35:54 UTC (rev 1108)
@@ -445,7 +445,7 @@
 			return tmp;
                     default:
                         /* What? */
-                        SigScm_ErrorObj("eval : What type of function? ", tmp);
+                        SigScm_ErrorObj("eval : What type of function? ", arg);
                 }
 
             }
@@ -1205,7 +1205,9 @@
     ScmObj test       = SCM_NIL;
     ScmObj expression = SCM_NIL;
     ScmObj commands   = SCM_NIL;
+    ScmObj tmp_vars   = SCM_NIL;
     ScmObj tmp_steps  = SCM_NIL;
+    ScmObj obj        = SCM_NIL;
 
     /* sanity check */
     if (SCM_INT_VALUE(ScmOp_length(arg)) < 2)
@@ -1217,15 +1219,12 @@
 	vars = Scm_NewCons(SCM_CAR(binding), vars);
 	vals = Scm_NewCons(ScmOp_eval(SCM_CAR(SCM_CDR(binding)), env), vals);
 
+	/* append <step> to steps */
 	step = SCM_CDR(SCM_CDR(binding));
-	if (!SCM_NULLP(step)) {
-	    step = SCM_CAR(step);
-
-	    /* append (<var> <step>) to steps */
-	    steps = Scm_NewCons(Scm_NewCons(SCM_CAR(binding),
-					    Scm_NewCons(step, SCM_NIL)),
-				steps);
-	}
+	if (SCM_NULLP(step))
+	    steps = Scm_NewCons(SCM_CAR(binding), steps);	
+	else
+	    steps = Scm_NewCons(SCM_CAR(step), steps);
     }
 
     /* now extend environment */
@@ -1240,13 +1239,32 @@
     commands = SCM_CDR(SCM_CDR(arg));
 
     /* now excution phase! */
-    while (!SCM_EQ(ScmOp_eval(test, env), SCM_TRUE)) {
+    while (SCM_EQ(ScmOp_eval(test, env), SCM_FALSE)) {
+	/* execute commands */
 	ScmOp_eval(ScmExp_begin(commands, &env), env);
 
-	tmp_steps = steps;
-	for (; !SCM_NULLP(tmp_steps); tmp_steps = SCM_CDR(tmp_steps)) {
-	    ScmExp_set(SCM_CAR(tmp_steps), &env);
+	/*
+	 * Notice
+	 *
+	 * the result of the execution of <step>s must not depend on each other's
+	 * results. each excution must be done independently. So, we store the
+	 * results to the "vals" variable and set it in hand.
+	 */
+	vals = SCM_NIL;
+	for (tmp_steps = steps; !SCM_NULLP(tmp_steps); tmp_steps = SCM_CDR(tmp_steps)) {
+	    vals = Scm_NewCons(ScmOp_eval(SCM_CAR(tmp_steps), env), vals);
 	}
+	vals = ScmOp_reverse(vals);
+
+	/* set it */
+	for (tmp_vars = vars; !SCM_NULLP(tmp_vars) && !SCM_NULLP(vals); tmp_vars = SCM_CDR(tmp_vars), vals = SCM_CDR(vals)) {
+	    obj = lookup_environment(SCM_CAR(tmp_vars), env);
+	    if (!SCM_NULLP(obj)) {
+		SCM_SETCAR(obj, SCM_CAR(vals));
+	    } else {
+		SigScm_Error("do : broken env\n");
+	    }
+	}
     }
 
     /* set new env */

Modified: branches/r5rs/sigscheme/test/test-exp.scm
===================================================================
--- branches/r5rs/sigscheme/test/test-exp.scm	2005-08-02 19:12:23 UTC (rev 1107)
+++ branches/r5rs/sigscheme/test/test-exp.scm	2005-08-02 20:35:54 UTC (rev 1108)
@@ -169,4 +169,16 @@
     (set! y (* x y))))
 (assert-eq? "do test3" 1024 (expt-do 2 10))
 
+(define (nreverse rev-it)
+  (do ((reved '() rev-it)
+       (rev-cdr (cdr rev-it) (cdr rev-cdr))
+       (rev-it rev-it rev-cdr))
+      ((begin
+	 (set-cdr! rev-it reved)
+	 (null? rev-cdr))
+       rev-it)))
+(assert-equal? "do test4" '(c b a) (nreverse '(a b c)))
+(assert-equal? "do test5" '((5 6) (3 4) (1 2)) (nreverse '((1 2) (3 4) (5 6))))
+
+
 (total-report)