Undo FLUID-LET changes from last version.

diff --git a/v7/src/runtime/syntax.scm b/v7/src/runtime/syntax.scm
index d37bed313e4f8502febb404e0ea00718e8f4be3f..8ac22960fc56dc5638e508d2b9a308b2ba4c5b00 100644 (file)
--- a/v7/src/runtime/syntax.scm
+++ b/v7/src/runtime/syntax.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/Attic/syntax.scm,v 13.45 1987/05/19 13:38:56 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/Attic/syntax.scm,v 13.46 1987/05/21 16:40:59 cph Exp $
 ;;;
 ;;;    Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -559,7 +559,7 @@
 
     (define (syntax-fluid-bindings bindings receiver)
       (if (null? bindings)
-         (receiver '() '() (list false) (list false))
+         (receiver '() '() '() '())
          (syntax-fluid-bindings (cdr bindings)
            (lambda (names values transfers-in transfers-out)
              (let ((binding (car bindings)))
@@ -568,11 +568,11 @@
                           (let ((reference (syntax-expression (car binding))))
                             (let ((assignment (invert-expression reference)))
                               (lambda (target source)
-                                (make-sequence*
-                                 (make-assignment target reference)
-                                 (assignment (make-variable source))
-                                 (make-assignment source
-                                                  unassigned-object))))))
+                                (make-assignment
+                                 target
+                                 (assignment
+                                  (make-assignment source
+                                                   unassigned-object)))))))
                          (value (expand-binding-value (cdr binding)))
                          (inside-name
                           (string->uninterned-symbol "INSIDE-PLACEHOLDER"))

diff --git a/v7/src/runtime/unsyn.scm b/v7/src/runtime/unsyn.scm
index 29b518dea2c63315e50963279e57e56c6c14c164..4c4e0494b3c86cb269eb0307bc31d8cd910585c8 100644 (file)
--- a/v7/src/runtime/unsyn.scm
+++ b/v7/src/runtime/unsyn.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unsyn.scm,v 13.43 1987/05/19 13:38:31 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unsyn.scm,v 13.44 1987/05/21 16:41:30 cph Exp $
 ;;;
 ;;;    Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -331,8 +331,7 @@
   (combination-components body
     (lambda (operator operands)
       `(FLUID-LET ,(unsyntax-let-bindings
-                   (extract-transfer-variables
-                    (sequence-actions (lambda-body (car operands))))
+                   (map extract-transfer-var (lambda-body (car operands)))
                    (let every-other ((values values))
                      (if (null? values)
                          '()
@@ -341,11 +340,21 @@
             (lambda (name required optional rest body)
               (unsyntax-sequence body)))))))
 
-(define (extract-transfer-variables actions)
-  (if (assignment? (car actions))
-      (cons (unsyntax-object (assignment-value (car actions)))
-           (extract-transfer-variables (cdddr actions)))
-      '()))
+(define (extract-transfer-var assignment)
+  (assignment-components assignment
+    (lambda (name value)
+      (cond ((assignment? value)
+            (assignment-components value (lambda (name value) name)))
+           ((combination? value)
+            (combination-components value
+              (lambda (operator operands)
+                (cond ((eq? operator lexical-assignment)
+                       `(ACCESS ,(cadr operands)
+                                ,@(unexpand-access (car operands))))
+                      (else
+                       (error "FLUID-LET: Unknown SCODE form" assignment))))))
+           (else
+            (error "FLUID-LET: Unknown SCODE form" assignment))))))
 \f
 (define ((unsyntax-deep-or-common-FLUID-LET name prim)
         ignored-required ignored-operands body)