From: Taylor R Campbell <campbell@mumble.net>
Date: Sun, 17 Oct 2010 20:33:23 +0000 (+0000)
Subject: Fix FLUID-LET of ACCESS.
X-Git-Tag: 20101212-Gtk~31
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=86fbfa795e1c37138776472f82204446f508b452;p=mit-scheme.git

Fix FLUID-LET of ACCESS.
---

diff --git a/src/runtime/mit-macros.scm b/src/runtime/mit-macros.scm
index 461cb8333..c1113e442 100644
--- a/src/runtime/mit-macros.scm
+++ b/src/runtime/mit-macros.scm
@@ -528,7 +528,7 @@ USA.
    (lambda (form rename compare)
      compare
      (syntax-check '(KEYWORD (* (FORM ? EXPRESSION)) + FORM) form)
-     (let ((names (map car (cadr form)))
+     (let ((left-hand-sides (map car (cadr form)))
 	   (right-hand-sides (map cdr (cadr form)))
 	   (r-define (rename 'DEFINE))
 	   (r-lambda (rename 'LAMBDA))
@@ -536,14 +536,18 @@ USA.
 	   (r-set! (rename 'SET!))
 	   (r-shallow-fluid-bind (rename 'SHALLOW-FLUID-BIND))
 	   (r-unspecific (rename 'UNSPECIFIC)))
-       (let ((temporaries (map make-synthetic-identifier names))
+       (let ((temporaries
+	      (map (lambda (lhs)
+		     (make-synthetic-identifier
+		      (if (identifier? lhs) lhs 'TEMPORARY)))
+		   left-hand-sides))
 	     (swap! (make-synthetic-identifier 'SWAP!))
 	     (body `(,r-lambda () ,@(cddr form))))
 	 `(,r-let ,(map cons temporaries right-hand-sides)
 	    (,r-define (,swap!)
-	      ,@(map (lambda (name temporary)
-		       `(,r-set! ,name (,r-set! ,temporary (,r-set! ,name))))
-		     names
+	      ,@(map (lambda (lhs temporary)
+		       `(,r-set! ,lhs (,r-set! ,temporary (,r-set! ,lhs))))
+		     left-hand-sides
 		     temporaries)
 	      ,r-unspecific)
 	    (,r-shallow-fluid-bind ,swap! ,body ,swap!)))))))