Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-08 13:37:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

Fix for letrec* - trailing non-procedure definitions cause earlier procedures to be treated as set!s.

Browse source 
Technically this is only needed if the non-proc defs reference the
earlier procedures, which leaves room for optimization later.
This commit is contained in:
Alex Shinn 2011-11-29 08:33:30 +09:00
parent e3d1414dcc
commit b22b0bc7a4
2 changed files with 16 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
eval.c
View file

@ -621,6 +621,7 @@ static sexp analyze_set (sexp ctx, sexp x) {
#define sexp_return(res, val) do {res=val; goto cleanup;} while (0)
static sexp analyze_lambda (sexp ctx, sexp x) {
int trailing_non_procs;
sexp name, ls, ctx3;
sexp_gc_var6(res, body, tmp, value, defs, ctx2);
sexp_gc_preserve6(ctx, res, body, tmp, value, defs, ctx2);
@ -646,6 +647,7 @@ static sexp analyze_lambda (sexp ctx, sexp x) {
body = analyze_seq(ctx2, sexp_cddr(x));
if (sexp_exceptionp(body)) sexp_return(res, body);
/* delayed analyze internal defines */
trailing_non_procs = 0;
defs = SEXP_NULL;
for (ls=sexp_lambda_defs(res); sexp_pairp(ls); ls=sexp_cdr(ls)) {
tmp = sexp_car(ls);
@ -664,7 +666,8 @@ static sexp analyze_lambda (sexp ctx, sexp x) {
if (sexp_lambdap(value)) sexp_lambda_name(value) = name;
sexp_push(ctx3, defs,
sexp_make_set(ctx3, analyze_var_ref(ctx3, name, NULL), value));
if (!sexp_lambdap(value) || !SEXP_USE_UNBOXED_LOCALS)
if (!sexp_lambdap(value)) trailing_non_procs = 1;
if (trailing_non_procs || !SEXP_USE_UNBOXED_LOCALS)
sexp_insert(ctx3, sexp_lambda_sv(res), name);
}
if (sexp_pairp(defs)) {

24
tests/r7rs-tests.scm
View file

@ -116,18 +116,18 @@
(even? (- n 1))))))
(even? 88)))
;; (test 5
;; (letrec* ((p
;; (lambda (x)
;; (+ 1 (q (- x 1)))))
;; (q
;; (lambda (y)
;; (if (zero? y)
;; 0
;; (+ 1 (p (- y 1))))))
;; (x (p 5))
;; (y x))
;; y))
(test 5
(letrec* ((p
(lambda (x)
(+ 1 (q (- x 1)))))
(q
(lambda (y)
(if (zero? y)
0
(+ 1 (p (- y 1))))))
(x (p 5))
(y x))
y))
(let*-values (((root rem) (exact-integer-sqrt 32)))
(test 35 (* root rem)))