From 44f9bbddddbede4b8b42d76a95da237a80cf0ff9 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Wed, 31 Oct 2012 22:27:01 +0100 Subject: [PATCH] Fix #944 by making the behvior of macro-renamed definitions inside modules similar to the behavior at toplevel; they unhygienically introduce identifiers --- chicken-syntax.scm | 5 ++++- expand.scm | 6 ++++-- tests/syntax-tests.scm | 26 +++++++++++++++++++++++++- 3 files changed, 33 insertions(+), 4 deletions(-) diff --git a/chicken-syntax.scm b/chicken-syntax.scm index 5de86f0..8fd85a3 100644 --- a/chicken-syntax.scm +++ b/chicken-syntax.scm @@ -348,7 +348,10 @@ (##sys#er-transformer (lambda (form r c) (##sys#check-syntax 'define-values form '(_ #(variable 0) _)) - (for-each (cut ##sys#register-export <> (##sys#current-module)) (cadr form)) + (for-each (lambda (nm) + (let ((name (##sys#get nm '##core#macro-alias nm))) + (##sys#register-export name (##sys#current-module)))) + (cadr form)) `(,(r 'set!-values) ,@(cdr form)))))) (##sys#extend-macro-environment diff --git a/expand.scm b/expand.scm index 660d1fa..06227e2 100644 --- a/expand.scm +++ b/expand.scm @@ -981,7 +981,8 @@ (body (cddr form)) ) (cond ((not (pair? head)) (##sys#check-syntax 'define form '(_ symbol . #(_ 0 1))) - (##sys#register-export head (##sys#current-module)) + (let ((name (or (getp head '##core#macro-alias) head))) + (##sys#register-export name (##sys#current-module))) (when (c (r 'define) head) (##sys#defjam-error x)) `(##core#set! @@ -1005,7 +1006,8 @@ (cond ((not (pair? head)) (##sys#check-syntax 'define-syntax head 'symbol) (##sys#check-syntax 'define-syntax body '#(_ 1)) - (##sys#register-export head (##sys#current-module)) + (let ((name (or (getp head '##core#macro-alias) head))) + (##sys#register-export name (##sys#current-module))) (when (c (r 'define-syntax) head) (##sys#defjam-error form)) `(##core#define-syntax ,head ,(car body))) diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm index cc5f246..6da0277 100644 --- a/tests/syntax-tests.scm +++ b/tests/syntax-tests.scm @@ -1054,4 +1054,28 @@ take (lambda (e r c) '(quote *))))) (import rename-builtins) -(assert (eq? '* (strip-syntax-on-*))) \ No newline at end of file +(assert (eq? '* (strip-syntax-on-*))) + +;; #944: macro-renamed defines mismatch with the names recorded in module +;; definitions, causing the module to be unresolvable. + +(module foo () + (import chicken scheme) + (define-syntax bar + (syntax-rules () + ((_) (begin (define req 1) (display req) (newline))))) + (bar)) + +;; The fix for the above bug causes the req to be defined at toplevel, +;; unhygienically. The test below should probably be enabled and this +;; behavior fixed. R5RS seems to allow the current behavior though (?), +;; and some Schemes (at least Gauche) behave the same way. I think it's +;; broken, since it's unhygienic. +#;(module foo () + (import chicken scheme) + (define req 1) + (define-syntax bar + (syntax-rules () + ((_) (begin (define req 2) (display req) (newline))))) + (bar) + (assert (eq? req 1))) \ No newline at end of file -- 1.7.12.2