~ chicken-core (chicken-5) 535189477983ed973fe8a5587d1b638b4cae7720

commit 535189477983ed973fe8a5587d1b638b4cae7720
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Thu Apr 27 17:43:13 2017 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Thu May 4 18:30:58 2017 +1200

    Restore macro-expansion in canonicalize-body's "main" loop
    
    In commit c9220247dbcdf6fd39697b428cfd40068244219a, we removed a little
    bit too much: the original code's expansion in the main loop would
    expand begins and defines at the root level, which means they'd be
    "flattened" into the same letrec.
    
    This broke a few situations that are technically somewhat iffy, like
    
      (let () (define (foo) bar) (begin (define (bar) 1) (foo)))
    
    which would error out instead of returning 1, because the begin would
    stop the main loop and inject a new letrec, acting as a barrier, which
    means later definitions are in a new scope that the earlier definitions
    would not be able to see.
    
    Also, if there's an macro that expands to "define", that would also be
    put in its own letrec because macro-expansion would stop the current
    collection of vars and mvars, much like the aforementioned begin.
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/expand.scm b/expand.scm
index 35b86dd6..4397d22a 100644
--- a/expand.scm
+++ b/expand.scm
@@ -632,7 +632,15 @@
 		     (loop rest (cons (cadr x) vars) (cons (caddr x) vals) (cons #t mvars)))
 		    ((comp '##core#begin head)
 		     (loop (##sys#append (cdr x) rest) vars vals mvars))
-		    (else (fini vars vals mvars body))))))))
+		    (else
+		     ;; Do not macro-expand local definitions we are
+		     ;; in the process of introducing.
+		     (if (member (list head) vars)
+			 (fini vars vals mvars body)
+			 (let ((x2 (##sys#expand-0 x se cs?)))
+			   (if (eq? x x2)
+			       (fini vars vals mvars body)
+			       (loop (cons x2 rest) vars vals mvars)))))))))))
     (expand body) ) )
 
 
diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm
index a8032203..1c4941a9 100644
--- a/tests/syntax-tests.scm
+++ b/tests/syntax-tests.scm
@@ -797,6 +797,12 @@
 
 ;; Nested begins inside definitions were not treated correctly
 (t 3 (eval '(let () (begin 1 (begin 2 (define internal-def 3) internal-def)))))
+;; Macros that expand to "define" should not cause a letrec barrier
+(t 1 (eval '(let-syntax ((my-define (syntax-rules ()
+				      ((_ var val) (define var val)))))
+	      (let () (define (run-it) foo) (my-define foo 1) (run-it)))))
+;; Begin should not cause a letrec barrier
+(t 1 (eval '(let () (define (run-it) foo) (begin (define foo 1) (run-it)))))
 (f (eval '(let () internal-def)))
 
 ;;; renaming of keyword argument (#277)