~ chicken-core (chicken-5) 8115df7e2d86cdf5d5e160c1604ef69545bd03b0
commit 8115df7e2d86cdf5d5e160c1604ef69545bd03b0 Author: felix <felix@call-with-current-continuation.org> AuthorDate: Sat Dec 11 13:31:01 2010 +0100 Commit: felix <felix@call-with-current-continuation.org> CommitDate: Sat Dec 11 13:31:01 2010 +0100 fix for IR renaming bug by sjamaan diff --git a/expand.scm b/expand.scm index 24cdaeec..9d9123b4 100644 --- a/expand.scm +++ b/expand.scm @@ -775,6 +775,7 @@ (lambda (a) (cond ((symbol? a) (dd `(RENAME/LOOKUP: ,sym --> ,a)) + (set! renv (cons (cons sym a) renv)) a) (else (let ((a2 (macro-alias sym se))) @@ -829,6 +830,11 @@ r) ")") r)) + (define (assq-reverse s l) + (cond + ((null? l) #f) + ((eq? (cdar l) s) (car l)) + (else (assq-reverse s (cdr l))))) (define (mirror-rename sym) (cond ((pair? sym) (cons (mirror-rename (car sym)) (mirror-rename (cdr sym)))) @@ -841,6 +847,9 @@ (lambda (name) (dd "STRIP SYNTAX ON " sym " ---> " name) name)) + ((assq-reverse sym renv) => + (lambda (a) + (dd "REVERSING RENAME: " sym " --> " (car a)) (car a))) ((not renamed) (dd "IMPLICITLY RENAMED: " sym) (rename sym)) ((pair? renamed) diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm index 4da0f85d..e0114874 100644 --- a/tests/syntax-tests.scm +++ b/tests/syntax-tests.scm @@ -587,6 +587,16 @@ (1 ==> (lambda (x) x)) (else 'yep)))) +;; Literal quotation of a symbol, injected or not, should always result in that symbol +(module ir-se-test (run) + (import chicken scheme) + (define-syntax run + (ir-macro-transformer + (lambda (e i c) + `(quote ,(i 'void)))))) + +(import ir-se-test) +(t 'void (run)) ;;; local definitionsTrap