X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fir1opt.lisp;h=955f4c85f36f54b6bafed157fd9377675b05c5f8;hb=85c1cf858999279da6f4f470c4f3c582ad9f2dbf;hp=cb198bdbf15f7dd722b6916f83e3b466f2a3e81f;hpb=6053e7f804b430144bb09e2d107ad4ab3fb97db4;p=sbcl.git

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index cb198bd..955f4c8 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -21,6 +21,7 @@
 ;;; Return true for an LVAR whose sole use is a reference to a
 ;;; constant leaf.
 (defun constant-lvar-p (thing)
+  (declare (type (or lvar null) thing))
   (and (lvar-p thing)
        (let ((use (principal-lvar-use thing)))
          (and (ref-p use) (constant-p (ref-leaf use))))))
@@ -446,21 +447,24 @@
   (let ((result (return-result node)))
     (collect ((use-union *empty-type* values-type-union))
       (do-uses (use result)
-	(cond ((and (basic-combination-p use)
-		    (eq (basic-combination-kind use) :local))
-	       (aver (eq (lambda-tail-set (node-home-lambda use))
-			 (lambda-tail-set (combination-lambda use))))
-	       (when (combination-p use)
-		 (when (nth-value 1 (maybe-convert-tail-local-call use))
-		   (return-from find-result-type (values)))))
-	      (t
-	       (use-union (node-derived-type use)))))
+        (let ((use-home (node-home-lambda use)))
+          (cond ((or (eq (functional-kind use-home) :deleted)
+                     (block-delete-p (node-block use))))
+                ((and (basic-combination-p use)
+                      (eq (basic-combination-kind use) :local))
+                 (aver (eq (lambda-tail-set use-home)
+                           (lambda-tail-set (combination-lambda use))))
+                 (when (combination-p use)
+                   (when (nth-value 1 (maybe-convert-tail-local-call use))
+                     (return-from find-result-type (values)))))
+                (t
+                 (use-union (node-derived-type use))))))
       (let ((int
              ;; (values-type-intersection
              ;; (continuation-asserted-type result) ; FIXME -- APD, 2002-01-26
              (use-union)
               ;; )
-            ))
+              ))
 	(setf (return-result-type node) int))))
   (values))