~ chicken-core (chicken-5) 315fc3698727803ad74dd424b365d5ae1c56d5cf
commit 315fc3698727803ad74dd424b365d5ae1c56d5cf Author: Peter Bex <peter.bex@xs4all.nl> AuthorDate: Thu Jun 23 22:28:56 2011 +0200 Commit: Peter Bex <peter.bex@xs4all.nl> CommitDate: Thu Jun 23 22:28:56 2011 +0200 Peter, whenever you change something, check to see if *all* occurrences of the same kind of thing are handled! diff --git a/expand.scm b/expand.scm index ef6c10ae..6747135a 100644 --- a/expand.scm +++ b/expand.scm @@ -77,9 +77,10 @@ (char=? #\# (##core#inline "C_subchar" str 0))))) var (let* ((alias (gensym var)) - (ua (or (lookup var se) var))) + (ua (or (lookup var se) var)) + (rn (or (getp var '##core#real-name) var))) (putp alias '##core#macro-alias ua) - (putp alias '##core#real-name var) + (putp alias '##core#real-name rn) (dd "aliasing " alias " (real: " var ") to " (if (pair? ua) '<macro> @@ -836,17 +837,17 @@ ((not (symbol? sym)) sym) (else ; Code stolen from ##sys#strip-syntax (let ((renamed (lookup sym se) ) ) - (cond ((getp sym '##core#real-name) => - (lambda (name) - (dd "STRIP SYNTAX ON " sym " ---> " name) - name)) - ((assq-reverse sym renv) => + (cond ((assq-reverse sym renv) => (lambda (a) (dd "REVERSING RENAME: " sym " --> " (car a)) (car a))) ((not renamed) (dd "IMPLICITLY RENAMED: " sym) (rename sym)) ((pair? renamed) (dd "MACRO: " sym) (rename sym)) + ((getp sym '##core#real-name) => + (lambda (name) + (dd "STRIP SYNTAX ON " sym " ---> " name) + name)) (else (dd "BUILTIN ALIAS:" renamed) renamed)))))) (if explicit-renaming? ;; Let the user handle renaming diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm index b01de67f..969420cf 100644 --- a/tests/syntax-tests.scm +++ b/tests/syntax-tests.scm @@ -208,6 +208,18 @@ (t "x" (symbol->string (c))) +(define-syntax c2 + (syntax-rules () + [(_) + (let ([x 10]) + (let-syntax ([z (syntax-rules () + [(_) (let-syntax ([w (syntax-rules () + [(_) (quote x)])]) + (w))])]) + (z)))])) + +(t "x" (symbol->string (c2))) + ;;; strip-syntax on renamed module identifiers, as well as core identifiers (module foo (bar) (import chicken scheme)Trap