From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 8 May 1987 02:33:21 +0000 (+0000)
Subject: Change code that optimizes let-like combinations so that it only
X-Git-Tag: 20090517-FFI~13541
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=38406b2130a3401531f0fd66bf752fa76a89935d;p=mit-scheme.git

Change code that optimizes let-like combinations so that it only
removes parameters that are declared integrable, rather than
unreferenced parameters.  This is a makeshift arrangement until we can
perform side effect analysis on the operands to determine which ones
are really needed.
---

diff --git a/v7/src/sf/subst.scm b/v7/src/sf/subst.scm
index b4098519f..06d78ef85 100644
--- a/v7/src/sf/subst.scm
+++ b/v7/src/sf/subst.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/subst.scm,v 3.4 1987/05/04 23:51:57 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/subst.scm,v 3.5 1987/05/08 02:33:21 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -466,30 +466,34 @@ MIT in each case. |#
 	;; Simple LET-like combination.  Delete any unreferenced
 	;; parameters.  If no parameters remain, delete the
 	;; combination and lambda.
-	(let ((body (procedure/body operator)))
-	  (transmit-values ((delete-unused-parameters (free/expression body))
-			    (procedure/required operator)
-			    operands)
-	    (lambda (required operands)
-	      (if (null? required)
-		  body
-		  (combination/make (procedure/make (procedure/block operator)
-						    (procedure/name operator)
-						    required '() false body)
-				    operands)))))
+	(transmit-values ((delete-integrated-parameters
+			   (declarations/integrated-variables
+			    (block/declarations (procedure/block operator))))
+			  (procedure/required operator)
+			  operands)
+	  (lambda (required operands)
+	    (if (null? required)
+		(procedure/body operator)
+		(combination/make (procedure/make (procedure/block operator)
+						  (procedure/name operator)
+						  required
+						  '()
+						  false
+						  (procedure/body operator))
+				  operands))))
 	(combination/make operator operands))))
 
-(define (delete-unused-parameters referenced)
+(define (delete-integrated-parameters integrated)
   (define (loop parameters operands)
     (if (null? parameters)
 	(return-2 '() operands)
 	(let ((rest (loop (cdr parameters) (cdr operands))))
-	  (if (memq (car parameters) referenced)
+	  (if (memq (car parameters) integrated)
+	      rest
 	      (transmit-values rest
 		(lambda (parameters* operands*)
 		  (return-2 (cons (car parameters) parameters*)
-			    (cons (car operands) operands*))))
-	      rest))))
+			    (cons (car operands) operands*))))))))
   loop)
 
 ;;; end COMBINATION/OPTIMIZING-MAKE