Change semantics of procedure's name so that it is not considered to

be a bound variable.

diff --git a/v7/src/sf/cgen.scm b/v7/src/sf/cgen.scm
index abc6177b33e55c07dc868996f901be5527735db9..19d55ecb38804c412b1dcb9a90c4cf0cc09fad9b 100644 (file)
--- a/v7/src/sf/cgen.scm
+++ b/v7/src/sf/cgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/cgen.scm,v 3.2 1987/03/13 04:11:49 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/cgen.scm,v 3.3 1987/03/20 23:49:11 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -143,7 +143,7 @@ MIT in each case. |#
 \f
 (define-method/cgen 'PROCEDURE
   (lambda (interns procedure)
-    (make-lambda* (variable/name (procedure/name procedure))
+    (make-lambda* (procedure/name procedure)
                  (map variable/name (procedure/required procedure))
                  (map variable/name (procedure/optional procedure))
                  (let ((rest (procedure/rest procedure)))

diff --git a/v7/src/sf/copy.scm b/v7/src/sf/copy.scm
index d0e5fcfae30c46117fc7566c807affac0204c28d..d9efd13ea3cd7d98751ce3de50756efc4f96b95a 100644 (file)
--- a/v7/src/sf/copy.scm
+++ b/v7/src/sf/copy.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/copy.scm,v 3.2 1987/03/13 04:12:02 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/copy.scm,v 3.3 1987/03/20 23:49:22 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -234,7 +234,7 @@ MIT in each case. |#
       (lambda (block environment)
        (let ((rename (make-renamer environment)))
          (procedure/make block
-                         (rename (procedure/name procedure))
+                         (procedure/name procedure)
                          (map rename (procedure/required procedure))
                          (map rename (procedure/optional procedure))
                          (let ((rest (procedure/rest procedure)))

diff --git a/v7/src/sf/make.scm b/v7/src/sf/make.scm
index bb9ff130b75c141947506e95cf441e3499d62c5b..0b1699b2f82eddeb66125747dc81d5470b514463 100644 (file)
--- a/v7/src/sf/make.scm
+++ b/v7/src/sf/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 3.3 1987/03/13 04:12:41 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 3.4 1987/03/20 23:50:32 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -108,7 +108,7 @@ MIT in each case. |#
     (make-environment
       (define :name "SF")
       (define :version 3)
-      (define :modification 2)))
+      (define :modification 3)))
 
   (add-system! scode-optimizer/system)
 

diff --git a/v7/src/sf/subst.scm b/v7/src/sf/subst.scm
index aa336045b6e6183258588d3ea9b01b06d2a2a74f..3ffe3721cce88b94460f19b3be6f52964f03a810 100644 (file)
--- 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.2 1987/03/13 04:13:46 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/subst.scm,v 3.3 1987/03/20 23:49:33 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -424,35 +424,26 @@ MIT in each case. |#
 
 (set! combination/optimizing-make
   (lambda (operator operands)
-    (let ((dont-optimize
-          (lambda ()
-            (combination/make operator operands))))
-      (if (and (procedure? operator)
-              (null? (procedure/optional operator))
-              (not (procedure/rest operator))
-              (block/safe? (procedure/block operator))
-              (not (open-block? (procedure/body operator))))
-         (let ((body (procedure/body operator)))
-           (let ((referenced (free/expression body)))
-             (if (not (memq (procedure/name operator)
-                            referenced)) ;i.e. not a loop
-                 ;; Simple LET-like combination.  Delete any
-                 ;; unreferenced parameters.  If no parameters
-                 ;; remain, delete the combination and lambda.
-                 (transmit-values
-                     ((delete-unused-parameters referenced)
-                      (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))))
-                 (dont-optimize))))
-         (dont-optimize)))))
+    (if (and (procedure? operator)
+            (null? (procedure/optional operator))
+            (not (procedure/rest operator))
+            (block/safe? (procedure/block operator))
+            (not (open-block? (procedure/body operator))))
+       ;; 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)))))
+       (combination/make operator operands))))
 
 (define (delete-unused-parameters referenced)
   (define (loop parameters operands)

diff --git a/v7/src/sf/xform.scm b/v7/src/sf/xform.scm
index 63095ac4db7544e400933df837a33cf0c087d2b0..70bf91727a25e44dfe33e6ff029fa7363e128082 100644 (file)
--- a/v7/src/sf/xform.scm
+++ b/v7/src/sf/xform.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/xform.scm,v 3.2 1987/03/13 04:14:48 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/xform.scm,v 3.3 1987/03/20 23:49:46 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -151,13 +151,11 @@ MIT in each case. |#
       (let ((block (block/make block true)))
        (transmit-values
            (let ((name->variable (lambda (name) (variable/make block name))))
-             (return-4 (name->variable name)
-                       (map name->variable required)
+             (return-3 (map name->variable required)
                        (map name->variable optional)
                        (and rest (name->variable rest))))
-         (lambda (name required optional rest)
-           (let ((bound
-                  `(,name ,@required ,@optional ,@(if rest `(,rest) '()))))
+         (lambda (required optional rest)
+           (let ((bound `(,@required ,@optional ,@(if rest `(,rest) '()))))
              (block/set-bound-variables! block bound)
              (procedure/make
               block name required optional rest

diff --git a/v8/src/sf/make.scm b/v8/src/sf/make.scm
index a750f65d0484573672aa38e8ed57a2547a349c7d..fc654f119e7b0c40c5c639038929c396bb51690c 100644 (file)
--- a/v8/src/sf/make.scm
+++ b/v8/src/sf/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 3.3 1987/03/13 04:12:41 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 3.4 1987/03/20 23:50:32 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -108,7 +108,7 @@ MIT in each case. |#
     (make-environment
       (define :name "SF")
       (define :version 3)
-      (define :modification 2)))
+      (define :modification 3)))
 
   (add-system! scode-optimizer/system)