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 588baee96d8a1faa59b35fa40098e0f2fbdc6546..c6b0b17922f5189fceba24cacfd580ee9b6c3035 100644 (file)
--- 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))