~ chicken-core (chicken-5) caa54d22321cff3be2657c07a1c66d62ea9f3370

commit caa54d22321cff3be2657c07a1c66d62ea9f3370
Author:     Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Mon Mar 14 20:50:57 2011 +0100
Commit:     Peter Bex <peter.bex@xs4all.nl>
CommitDate: Mon Mar 14 20:50:57 2011 +0100

    Implement proper fix for #518

diff --git a/compiler.scm b/compiler.scm
index 9103a53f..0ba5b4a0 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -1276,7 +1276,7 @@
   (define (globalize sym)
     (if (symbol? sym)
 	(let loop ((se se))			; ignores syntax bindings
-	  (cond ((null? se) (##sys#alias-global-hook sym #f #f)) ;XXX could hint at decl (3rd arg)
+	  (cond ((null? se) (strip (##sys#alias-global-hook sym #f #f))) ;XXX could hint at decl (3rd arg)
 		((and (eq? sym (caar se)) (symbol? (cdar se))) (cdar se))
 		(else (loop (cdr se)))))
 	sym))
diff --git a/expand.scm b/expand.scm
index 27d3f0dd..b8c50262 100644
--- a/expand.scm
+++ b/expand.scm
@@ -269,12 +269,10 @@
 (define ##sys#enable-runtime-macros #f)
 
 (define (##sys#module-rename sym prefix)
-  (let ((qualified-symbol (##sys#string->symbol (string-append
-                                                 (##sys#slot prefix 1)
-                                                 "#"
-                                                 (##sys#slot sym 1) ) )))
-    (putp qualified-symbol '##core#real-name sym)
-    qualified-symbol) )
+  (##sys#string->symbol (string-append
+                         (##sys#slot prefix 1)
+                         "#"
+                         (##sys#slot sym 1) ) ) )
 
 (define (##sys#alias-global-hook sym assign where)
   (define (mrename sym)
@@ -785,9 +783,18 @@
 	    ((lookup sym se) => 
 	     (lambda (a)
 	       (cond ((symbol? a)
-		      (dd `(RENAME/LOOKUP: ,sym --> ,a))
-                      (set! renv (cons (cons sym a) renv))
-		      a)
+                      ;; Add an extra level of indirection for already aliased
+                      ;; symbols.  This prevents aliased symbols from popping up
+                      ;; in syntax-stripped output.
+                      (cond ((or (getp a '##core#aliased)
+                                 (getp a '##core#primitive))
+                             (let ((a2 (macro-alias sym se)))
+                               (dd `(RENAME/LOOKUP/ALIASED: ,sym --> ,a ==> ,a2))
+                               (set! renv (cons (cons sym a2) renv))
+                               a2))
+                            (else (dd `(RENAME/LOOKUP: ,sym --> ,a))
+                                  (set! renv (cons (cons sym a) renv))
+                                  a)))
 		     (else
 		      (let ((a2 (macro-alias sym se)))
 			(dd `(RENAME/LOOKUP/MACRO: ,sym --> ,a2))