From 144b11ecc6b1d5984be7a99e3141b3af9bce9869 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Thu, 27 Apr 2017 17:43:13 +0200 Subject: [PATCH] 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. --- expand.scm | 11 ++++++++++- tests/syntax-tests.scm | 6 ++++++ 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/expand.scm b/expand.scm index 3a6b436..472d3ca 100644 --- a/expand.scm +++ b/expand.scm @@ -630,7 +630,16 @@ (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 a803220..1c4941a 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) -- 2.1.4