Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs1:/tmp/cvs-serv8040/src/compiler
Modified Files:
ir1tran-lambda.lisp ir1util.lisp node.lisp
Log Message:
0.8.3.73:
* DELETE-LAMBDA: delete also contained lambdas.
Index: ir1tran-lambda.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1tran-lambda.lisp,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- ir1tran-lambda.lisp 16 Sep 2003 07:45:08 -0000 1.12
+++ ir1tran-lambda.lisp 17 Sep 2003 06:45:45 -0000 1.13
@@ -293,6 +293,10 @@
(result-ctran (make-ctran))
(result-lvar (make-lvar)))
+ (awhen (lexenv-lambda *lexenv*)
+ (push lambda (lambda-children it))
+ (setf (lambda-parent lambda) it))
+
;; just to check: This function should fail internal assertions if
;; we didn't set up a valid debug name above.
;;
Index: ir1util.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1util.lisp,v
retrieving revision 1.75
retrieving revision 1.76
diff -u -d -r1.75 -r1.76
--- ir1util.lisp 16 Sep 2003 09:45:15 -0000 1.75
+++ ir1util.lisp 17 Sep 2003 06:45:45 -0000 1.76
@@ -772,12 +772,12 @@
(clambda (delete-lambda fun)))
(values))
-;;; Deal with deleting the last reference to a CLAMBDA. Since there is
-;;; only one way into a CLAMBDA, deleting the last reference to a
-;;; CLAMBDA ensures that there is no way to reach any of the code in
-;;; it. So we just set the FUNCTIONAL-KIND for FUN and its LETs to
-;;; :DELETED, causing IR1 optimization to delete blocks in that
-;;; CLAMBDA.
+;;; Deal with deleting the last reference to a CLAMBDA. It is called
+;;; in two situations: when the lambda is unreachable (so that its
+;;; body mey be deleted), and when it is an effectless LET (in this
+;;; case its body is reachable and is not completely "its"). We set
+;;; FUNCTIONAL-KIND to :DELETED and rely on IR1-OPTIMIZE to delete its
+;;; blocks.
(defun delete-lambda (clambda)
(declare (type clambda clambda))
(let ((original-kind (functional-kind clambda))
@@ -786,6 +786,16 @@
(aver (not (functional-has-external-references-p clambda)))
(setf (functional-kind clambda) :deleted)
(setf (lambda-bind clambda) nil)
+
+ (when bind ; CLAMBDA is deleted due to unreachability
+ (labels ((delete-children (lambda)
+ (dolist (child (lambda-children lambda))
+ (if (eq (functional-kind child) :deleted)
+ (delete-children child)
+ (delete-lambda child))
+ (setf (lambda-children lambda) nil))
+ (setf (lambda-parent lambda) nil)))
+ (delete-children clambda)))
(dolist (let (lambda-lets clambda))
(setf (lambda-bind let) nil)
(setf (functional-kind let) :deleted))
Index: node.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/node.lisp,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -d -r1.44 -r1.45
--- node.lisp 16 Sep 2003 07:45:10 -0000 1.44
+++ node.lisp 17 Sep 2003 06:45:45 -0000 1.45
@@ -918,7 +918,10 @@
;; retain it so that if the LET is deleted (due to a lack of vars),
;; we will still have caller's lexenv to figure out which cleanup is
;; in effect.
- (call-lexenv nil :type (or lexenv null)))
+ (call-lexenv nil :type (or lexenv null))
+ ;; list of embedded lambdas
+ (children nil :type list)
+ (parent nil :type (or clambda null)))
(defprinter (clambda :conc-name lambda- :identity t)
%source-name
%debug-name
|