-;;; Deal with deleting the last reference to a LAMBDA. Since there is
-;;; only one way into a LAMBDA, deleting the last reference to a
-;;; LAMBDA 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
-;;; lambda.
-;;;
-;;; If the function isn't a LET, we unlink the function head and tail
-;;; from the component head and tail to indicate that the code is
-;;; unreachable. We also delete the function from COMPONENT-LAMBDAS
-;;; (it won't be there before local call analysis, but no matter.) If
-;;; the lambda was never referenced, we give a note.
-;;;
-;;; If the lambda is an XEP, then we null out the ENTRY-FUNCTION in its
-;;; ENTRY-FUNCTION so that people will know that it is not an entry point
-;;; anymore.
-(defun delete-lambda (leaf)
- (declare (type clambda leaf))
- (let ((kind (functional-kind leaf))
- (bind (lambda-bind leaf)))
- (aver (not (member kind '(:deleted :optional :top-level))))
- (aver (not (functional-has-external-references-p leaf)))
- (setf (functional-kind leaf) :deleted)
- (setf (lambda-bind leaf) nil)
- (dolist (let (lambda-lets leaf))
- (setf (lambda-bind let) nil)
- (setf (functional-kind let) :deleted))
-
- (if (member kind '(:let :mv-let :assignment))
- (let ((home (lambda-home leaf)))
- (setf (lambda-lets home) (delete leaf (lambda-lets home))))
- (let* ((bind-block (node-block bind))
- (component (block-component bind-block))
- (return (lambda-return leaf)))
- (aver (null (leaf-refs leaf)))
- (unless (leaf-ever-used leaf)
- (let ((*compiler-error-context* bind))
- (compiler-note "deleting unused function~:[.~;~:*~% ~S~]"
- (leaf-name leaf))))
- (unlink-blocks (component-head component) bind-block)
- (when return
- (unlink-blocks (node-block return) (component-tail component)))
- (setf (component-reanalyze component) t)
- (let ((tails (lambda-tail-set leaf)))
- (setf (tail-set-functions tails)
- (delete leaf (tail-set-functions tails)))
- (setf (lambda-tail-set leaf) nil))
- (setf (component-lambdas component)
- (delete leaf (component-lambdas component)))))
-
- (when (eq kind :external)
- (let ((fun (functional-entry-function leaf)))
- (setf (functional-entry-function fun) nil)
+;;; Deal with deleting the last reference to a CLAMBDA, which means
+;;; that the lambda is unreachable, so that its body may be
+;;; deleted. 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))
+ (bind (lambda-bind clambda)))
+ (aver (not (member original-kind '(:deleted :toplevel))))
+ (aver (not (functional-has-external-references-p clambda)))
+ (aver (or (eq original-kind :zombie) bind))
+ (setf (functional-kind clambda) :deleted)
+ (setf (lambda-bind clambda) nil)
+
+ (labels ((delete-children (lambda)
+ (dolist (child (lambda-children lambda))
+ (cond ((eq (functional-kind child) :deleted)
+ (delete-children child))
+ (t
+ (delete-lambda child))))
+ (setf (lambda-children lambda) nil)
+ (setf (lambda-parent lambda) nil)))
+ (delete-children clambda))
+
+ ;; (The IF test is (FUNCTIONAL-SOMEWHAT-LETLIKE-P CLAMBDA), except
+ ;; that we're using the old value of the KIND slot, not the
+ ;; current slot value, which has now been set to :DELETED.)
+ (case original-kind
+ (:zombie)
+ ((:let :mv-let :assignment)
+ (let ((bind-block (node-block bind)))
+ (mark-for-deletion bind-block))
+ (let ((home (lambda-home clambda)))
+ (setf (lambda-lets home) (delete clambda (lambda-lets home))))
+ ;; KLUDGE: In presence of NLEs we cannot always understand that
+ ;; LET's BIND dominates its body [for a LET "its" body is not
+ ;; quite its]; let's delete too dangerous for IR2 stuff. --
+ ;; APD, 2004-01-01
+ (dolist (var (lambda-vars clambda))
+ (flet ((delete-node (node)
+ (mark-for-deletion (node-block node))))
+ (mapc #'delete-node (leaf-refs var))
+ (mapc #'delete-node (lambda-var-sets var)))))
+ (t
+ ;; Function has no reachable references.
+ (dolist (ref (lambda-refs clambda))
+ (mark-for-deletion (node-block ref)))
+ ;; If the function isn't a LET, we unlink the function head
+ ;; and tail from the component head and tail to indicate that
+ ;; the code is unreachable. We also delete the function from
+ ;; COMPONENT-LAMBDAS (it won't be there before local call
+ ;; analysis, but no matter.) If the lambda was never
+ ;; referenced, we give a note.
+ (let* ((bind-block (node-block bind))
+ (component (block-component bind-block))
+ (return (lambda-return clambda))
+ (return-block (and return (node-block return))))
+ (unless (leaf-ever-used clambda)
+ (let ((*compiler-error-context* bind))
+ (compiler-notify 'code-deletion-note
+ :format-control "deleting unused function~:[.~;~:*~% ~S~]"
+ :format-arguments (list (leaf-debug-name clambda)))))
+ (unless (block-delete-p bind-block)
+ (unlink-blocks (component-head component) bind-block))
+ (when (and return-block (not (block-delete-p return-block)))
+ (mark-for-deletion return-block)
+ (unlink-blocks return-block (component-tail component)))
+ (setf (component-reanalyze component) t)
+ (let ((tails (lambda-tail-set clambda)))
+ (setf (tail-set-funs tails)
+ (delete clambda (tail-set-funs tails)))
+ (setf (lambda-tail-set clambda) nil))
+ (setf (component-lambdas component)
+ (delq clambda (component-lambdas component))))))
+
+ ;; If the lambda is an XEP, then we null out the ENTRY-FUN in its
+ ;; ENTRY-FUN so that people will know that it is not an entry
+ ;; point anymore.
+ (when (eq original-kind :external)
+ (let ((fun (functional-entry-fun clambda)))
+ (setf (functional-entry-fun fun) nil)