From 5defc05d458e5b2f97dfc34eafa9a3df617f82b5 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Mon, 15 Aug 2005 20:43:16 +0000 Subject: [PATCH 1/1] * eval.c (eval_letrec_inits): New. (CEVAL): Eval letrec initializer forms using eval_letrec_inits. * tests/r5rs_pitfall.test (1.1): Now passes. --- libguile/ChangeLog | 5 ++++ libguile/eval.c | 44 ++++++++++++++++++++---------- test-suite/ChangeLog | 4 +++ test-suite/tests/r5rs_pitfall.test | 6 +--- 4 files changed, 39 insertions(+), 20 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 775fb6989..4551ba0db 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2005-08-15 Neil Jerram + + * eval.c (eval_letrec_inits): New. + (CEVAL): Eval letrec initializer forms using eval_letrec_inits. + 2005-08-12 Marius Vollmer * numbers.c: Use scm_from_bool instead of SCM_BOOL. Thanks to diff --git a/libguile/eval.c b/libguile/eval.c index a2284027d..e4e617fe1 100644 --- 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); @@ -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 3b0afbc9f..32c4f573e 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,7 @@ +2005-08-15 Neil Jerram + + * tests/r5rs_pitfall.test (1.1): Now passes. + 2005-08-01 Marius Vollmer diff --git a/test-suite/tests/r5rs_pitfall.test b/test-suite/tests/r5rs_pitfall.test index 023dfef5a..1c99b5fc9 100644 --- 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)))) -- 2.20.1