From: Taylor R Campbell <campbell@mumble.net>
Date: Mon, 21 Sep 2009 22:38:22 +0000 (-0400)
Subject: When expanding (VALUES ...) in SF, integrate the receiver.
X-Git-Tag: 20100708-Gtk~321
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2e427a01de21193d7f95d8323e4d7f6b668c7228;p=mit-scheme.git

When expanding (VALUES ...) in SF, integrate the receiver.
---

diff --git a/src/sf/usiexp.scm b/src/sf/usiexp.scm
index 5d50463f2..d596073e0 100644
--- a/src/sf/usiexp.scm
+++ b/src/sf/usiexp.scm
@@ -351,7 +351,7 @@ USA.
       (make-combination expr block (ucode-primitive cons)
 			(list (car rest)
 			      (list-expansion-loop #f block (cdr rest))))))
-
+
 (define (values-expansion expr operands if-expanded if-not-expanded block)
   if-not-expanded
   (if-expanded
@@ -373,12 +373,18 @@ USA.
 	   (let ((variable (variable/make&bind! block 'RECEIVER)))
 	     (procedure/make
 	      #f block lambda-tag:unnamed (list variable) '() #f
-	      (combination/make #f
-				block
-				(reference/make #f block variable)
-				(map (lambda (variable)
-				       (reference/make #f block variable))
-				     variables))))))
+	      (declaration/make
+	       #f
+	       ;; The receiver is used only once, and all its operand
+	       ;; expressions are effect-free, so integrating here is
+	       ;; safe.
+	       (declarations/parse block '((INTEGRATE-OPERATOR RECEIVER)))
+	       (combination/make #f
+				 block
+				 (reference/make #f block variable)
+				 (map (lambda (variable)
+					(reference/make #f block variable))
+				      variables)))))))
 	operands)))))
 
 (define (call-with-values-expansion expr operands