Change code that optimizes let-like combinations so that it only
authorChris Hanson <org/chris-hanson/cph>
Fri, 8 May 1987 02:33:21 +0000 (02:33 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 8 May 1987 02:33:21 +0000 (02:33 +0000)
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.

v7/src/sf/subst.scm

index b4098519f35a2e497143bfc9326a32d31b6873d7..06d78ef85fe5be427cfcb4b9a9d1d877dc6491b1 100644 (file)
@@ -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