From: Taylor R Campbell Date: Thu, 22 Oct 2009 21:00:52 +0000 (-0400) Subject: Fix bug in recent transformations that caused inadvertent shadowing. X-Git-Tag: 20100708-Gtk~273^2~3 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=89668d2e956ed41cd5e3114465be88c0118f01c6;p=mit-scheme.git Fix bug in recent transformations that caused inadvertent shadowing. The real fix is to make cgen do alphatization, in which case copy.scm could be considerably simplified, but this hack works for now to fix, e.g., miscompilation of INITIALIZE-PACKAGE! in runtime/emacs.scm, which has (let ((type (select-console-port-type))) (if (let ((type (port/type the-console-port))) (or (eq? type vanilla-console-port-type) (eq? type emacs-console-port-type))) (set-port/type! the-console-port type))) => (let ((type (select-console-port-type))) (let ((type (port/type the-console-port))) (if (or (eq? type vanilla-console-port-type) (eq? type emacs-console-port-type)) (set-port/type! the-console-port type)))) One of the variables formerly named TYPE is now named by an uninterned symbol instead. --- diff --git a/src/sf/subst.scm b/src/sf/subst.scm index 588baee96..c6b0b1792 100644 --- a/src/sf/subst.scm +++ b/src/sf/subst.scm @@ -604,7 +604,16 @@ you ask for. (declaration/declarations declaration) expression)) +;;; Replacing the body may cause variables from outside the original +;;; body to be shadowed, so we use a sleazy stupid hack to work around +;;; this, because cgen doesn't do alphatization itself. (This is the +;;; same hack as used in copy.scm to copy integrated expressions that +;;; have free variables.) + (define (procedure-with-body procedure body) + (for-each hackify-variable (procedure/required procedure)) + (for-each hackify-variable (procedure/optional procedure)) + (cond ((procedure/rest procedure) => hackify-variable)) (procedure/make (procedure/scode procedure) (procedure/block procedure) (procedure/name procedure) @@ -613,6 +622,11 @@ you ask for. (procedure/rest procedure) body)) +(define (hackify-variable variable) + (set-variable/name! + variable + (string->uninterned-symbol (symbol-name (variable/name variable))))) + (define (sequence-with-actions sequence actions) (sequence/make (sequence/scode sequence) actions))