* eval.c (eval_letrec_inits): New.

(CEVAL): Eval letrec initializer forms using eval_letrec_inits.

* tests/r5rs_pitfall.test (1.1): Now passes.

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 775fb69..4551ba0 100644 (file)
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,8 @@
+2005-08-15  Neil Jerram  <neil@ossau.uklinux.net>
+
+       * eval.c (eval_letrec_inits): New.
+       (CEVAL): Eval letrec initializer forms using eval_letrec_inits.
+
 2005-08-12  Marius Vollmer  <mvo@zagadka.de>
 
        * numbers.c: Use scm_from_bool instead of SCM_BOOL.  Thanks to

diff --git a/libguile/eval.c b/libguile/eval.c
index a228402..e4e617f 100644 (file)
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -96,6 +96,7 @@ static SCM unmemoize_exprs (SCM expr, SCM env);
 static SCM canonicalize_define (SCM expr);
 static SCM *scm_lookupcar1 (SCM vloc, SCM genv, int check);
 static SCM unmemoize_builtin_macro (SCM expr, SCM env);
+static void eval_letrec_inits (SCM env, SCM init_forms, SCM **init_values_eol);
 
 \f
 
@@ -3148,6 +3149,30 @@ deval_args (SCM l, SCM env, SCM proc, SCM *lloc)
   return *results;
 }
 
+static void
+eval_letrec_inits (SCM env, SCM init_forms, SCM **init_values_eol)
+{
+  SCM argv[10];
+  int i = 0, imax = sizeof (argv) / sizeof (SCM);
+
+  while (!scm_is_null (init_forms))
+    {
+      if (imax == i)
+       {
+         eval_letrec_inits (env, init_forms, init_values_eol);
+         break;
+       }
+      argv[i++] = EVALCAR (init_forms, env);
+      init_forms = SCM_CDR (init_forms);
+    }
+
+  for (i--; i >= 0; i--)
+    {
+      **init_values_eol = scm_list_1 (argv[i]);
+      *init_values_eol = SCM_CDRLOC (**init_values_eol);
+    }
+}
+
 #endif /* !DEVAL */
 
 
@@ -3563,21 +3588,10 @@ dispatch:
           x = SCM_CDR (x);
           {
             SCM init_forms = SCM_CAR (x);
-            SCM init_values = SCM_EOL;
-            do
-              {
-                init_values = scm_cons (EVALCAR (init_forms, env), init_values);
-                init_forms = SCM_CDR (init_forms);
-              }
-            while (!scm_is_null (init_forms));
-
-           /* In order to make case 1.1 of the R5RS pitfall testsuite
-              succeed, we would need to copy init_values here like
-              so:
-
-              init_values = scm_list_copy (init_values);
-           */
-            SCM_SETCDR (SCM_CAR (env), init_values);
+           SCM init_values = scm_list_1 (SCM_BOOL_T);
+           SCM *init_values_eol = SCM_CDRLOC (init_values);
+           eval_letrec_inits (env, init_forms, &init_values_eol);
+            SCM_SETCDR (SCM_CAR (env), SCM_CDR (init_values));
           }
           x = SCM_CDR (x);
           PREP_APPLY (SCM_UNDEFINED, SCM_EOL);

diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog
index 3b0afbc..32c4f57 100644 (file)
--- a/test-suite/ChangeLog
+++ b/test-suite/ChangeLog
@@ -1,3 +1,7 @@
+2005-08-15  Neil Jerram  <neil@ossau.uklinux.net>
+
+       * tests/r5rs_pitfall.test (1.1): Now passes.
+
 2005-08-01  Marius Vollmer  <mvo@zagadka.de>
 
 

diff --git a/test-suite/tests/r5rs_pitfall.test b/test-suite/tests/r5rs_pitfall.test
index 023dfef..1c99b5f 100644 (file)
--- a/test-suite/tests/r5rs_pitfall.test
+++ b/test-suite/tests/r5rs_pitfall.test
@@ -18,8 +18,6 @@
 ;; These tests have been copied from
 ;; http://sisc.sourceforge.net/r5rs_pitfall.scm and the 'should-be'
 ;; macro has been modified to fit into our test suite machinery.
-;;
-;; Test 1.1 fails, but we expect that.
 
 (define-module (test-suite test-r5rs-pitfall)
   :use-syntax (ice-9 syncase)
@@ -48,9 +46,7 @@
 ;; defines in letrec body 
 ;; http://groups.google.com/groups?selm=87bsoq0wfk.fsf%40app.dial.idiom.com
 
-;; See eval.c for how to make this test succeed.  Look for "r5rs pitfall".
-
-(should-be-but-isnt 1.1 0
+(should-be 1.1 0
  (let ((cont #f))
    (letrec ((x (call-with-current-continuation (lambda (c) (set! cont c) 0)))
             (y (call-with-current-continuation (lambda (c) (set! cont c) 0))))