~ chicken-core (chicken-5) 0d7f83f4cfcb17d834331a34dac1fe57cab9ce55
commit 0d7f83f4cfcb17d834331a34dac1fe57cab9ce55
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Fri Apr 14 16:49:54 2017 +0200
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Wed Apr 19 11:20:06 2017 +1200
Do not undo macro renaming when renaming twice.
The "lookup" procedure will try to look up the renamed identifier in
the syntax env and if that fails, it checks whether the looked-up
identifier is an alias of another identifier, in which case it
returns the original identifier.
This fallback behaviour causes problems when we rename an identifier
twice. In normal use, that doesn't tend to happen (but it could).
When using IR macros, this happens all the time, because the input
form is completely renamed first, and then the output form is
reverse-renamed (renaming any "plain" identifiers in the process).
This behaviour will "collapse" any plain identifiers, so that, on the
reverse rename, they are mapped to the same identifier as those from
the input form.
This fixes ticket #1362, as found by Megane.
Signed-off-by: Evan Hanson <evhan@foldling.org>
diff --git a/NEWS b/NEWS
index c61cf58f..5a8193cd 100644
--- a/NEWS
+++ b/NEWS
@@ -76,6 +76,10 @@
- Unit srfi-4: Fixed typo that broke SRFI-17 generalised set! syntax
on s8vectors (thanks to Kristian Lein-Mathisen).
+- Syntax expander
+ - Renaming an identifier twice no longer results in an undo of the
+ rename (fixes #1362, thanks to "megane").
+
- Build system
- Fixed broken compilation on NetBSD, due to missing _NETBSD_SOURCE.
diff --git a/expand.scm b/expand.scm
index 02e69de1..b71a4de2 100644
--- a/expand.scm
+++ b/expand.scm
@@ -259,7 +259,7 @@
"syntax transformer for `" (symbol->string name)
"' returns original form, which would result in endless expansion")
exp))
- (dx `(,name --> ,exp2))
+ (dx `(,name ~~> ,exp2))
(expansion-result-hook exp exp2) ) ) )
(define (expand head exp mdef)
(dd `(EXPAND:
@@ -842,7 +842,7 @@
(lambda (a)
(dd `(RENAME/RENV: ,sym --> ,(cdr a)))
(cdr a)))
- ((lookup sym se) =>
+ ((assq sym se) =>
(lambda (a)
(cond ((symbol? a)
;; Add an extra level of indirection for already aliased
@@ -851,15 +851,15 @@
(cond ((or (getp a '##core#aliased)
(getp a '##core#primitive))
(let ((a2 (macro-alias sym se)))
- (dd `(RENAME/LOOKUP/ALIASED: ,sym --> ,a ==> ,a2))
+ (dd `(RENAME/SE/ALIASED: ,sym --> ,a ==> ,a2))
(set! renv (cons (cons sym a2) renv))
a2))
- (else (dd `(RENAME/LOOKUP: ,sym --> ,a))
+ (else (dd `(RENAME/SE: ,sym --> ,a))
(set! renv (cons (cons sym a) renv))
a)))
(else
(let ((a2 (macro-alias sym se)))
- (dd `(RENAME/LOOKUP/MACRO: ,sym --> ,a2))
+ (dd `(RENAME/SE/MACRO: ,sym --> ,a2))
(set! renv (cons (cons sym a2) renv))
a2)))))
(else
diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm
index 49f9d641..a8032203 100644
--- a/tests/syntax-tests.scm
+++ b/tests/syntax-tests.scm
@@ -1135,6 +1135,36 @@ other-eval
(import rename-builtins)
(assert (eq? '* (strip-syntax-on-*)))
+;; #1362: Double rename would cause "renamed" var to be restored to
+;; the original macro aliased name (resulting in a plain symbol)
+(let-syntax ((wrapper/should-do-nothing
+ (er-macro-transformer
+ (lambda (e r c)
+ (let* ((%x (r 'x))
+ (%%x (r %x)))
+ `(let ((,%x 1)
+ (,%%x 2))
+ ,(cadr e)))))))
+ (print (let ((x 1)) (wrapper/should-do-nothing x))))
+
+;; Same net effect as above, but more complex by the use of IR macros.
+(letrec-syntax ((bind-pair
+ (ir-macro-transformer
+ (lambda (e i c)
+ (let* ((b (cadr e))
+ (exp (caddr e))
+ (body (cdddr e)))
+ `(let* ((x ,exp)
+ (,(car b) (car x))
+ (,(cadr b) (cdr x)))
+ ,@body)))))
+ (foo
+ (ir-macro-transformer
+ (lambda (e i c)
+ `(bind-pair (x y) (cons 'foo-car 'foo-cdr) y)))))
+ (assert (eq? 'second (bind-pair (x y) (cons 'first 'second) y)))
+ (assert (eq? 'foo-cdr (foo))))
+
;; #944: macro-renamed defines mismatch with the names recorded in module
;; definitions, causing the module to be unresolvable.
Trap