- (when (and (block-flush-p block) (block-component block))
- (aver (not (block-delete-p block)))
- (flush-dead-code block)))))
+ ((or (block-delete-p block)
+ (null (block-pred block)))
+ (delete-block block))
+ ((eq (functional-kind (block-home-lambda block)) :deleted)
+ ;; Preserve the BLOCK-SUCC invariant that almost every block has
+ ;; one successor (and a block with DELETE-P set is an acceptable
+ ;; exception).
+ (mark-for-deletion block)
+ (delete-block block))
+ (t
+ (loop
+ (let ((succ (block-succ block)))
+ (unless (and succ (null (rest succ)))
+ (return)))
+
+ (let ((last (block-last block)))
+ (typecase last
+ (cif
+ (if (memq (continuation-type-check (if-test last))
+ '(nil :deleted))
+ ;; FIXME: Remove the test above when the bug 203
+ ;; will be fixed.
+ (progn
+ (flush-dest (if-test last))
+ (when (unlink-node last)
+ (return)))
+ (return)))
+ (exit
+ (when (maybe-delete-exit last)
+ (return)))))
+
+ (unless (join-successor-if-possible block)
+ (return)))
+
+ (when (and (block-reoptimize block) (block-component block))
+ (aver (not (block-delete-p block)))
+ (ir1-optimize-block block))
+
+ (cond ((block-delete-p block)
+ (delete-block block))
+ ((and (block-flush-p block) (block-component block))
+ (flush-dead-code block))))))