From: Chris Hanson Date: Fri, 20 Mar 1987 23:50:32 +0000 (+0000) Subject: Change semantics of procedure's name so that it is not considered to X-Git-Tag: 20090517-FFI~13655 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ad04139901fda521480b50faf5f34f3962956bed;p=mit-scheme.git 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 abc6177b3..19d55ecb3 100644 --- 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. |# (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 d0e5fcfae..d9efd13ea 100644 --- 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 bb9ff130b..0b1699b2f 100644 --- 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 aa336045b..3ffe3721c 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.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 63095ac4d..70bf91727 100644 --- 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 a750f65d0..fc654f119 100644 --- 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)