From b22b0bc7a41e95d399ceb9dc292b891797e5cf1d Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Tue, 29 Nov 2011 08:33:30 +0900
Subject: [PATCH] Fix for letrec* - trailing non-procedure definitions cause
 earlier procedures to be treated as set!s. Technically this is only needed if
 the non-proc defs reference the earlier procedures, which leaves room for
 optimization later.

---
 eval.c               |  5 ++++-
 tests/r7rs-tests.scm | 24 ++++++++++++------------
 2 files changed, 16 insertions(+), 13 deletions(-)

diff --git a/eval.c b/eval.c
index f426ed95..c2251069 100644
--- a/eval.c
+++ b/eval.c
@@ -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)) {
diff --git a/tests/r7rs-tests.scm b/tests/r7rs-tests.scm
index 3511dd86..fb2038a5 100644
--- a/tests/r7rs-tests.scm
+++ b/tests/r7rs-tests.scm
@@ -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)))