X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1opt.lisp;h=2ffc3850318564710acea8063412b4b8a6425330;hb=5d0643d3b70aade43037e8b7cdf39b7e12f5d3fd;hp=640468e6a6a25090e43b4af5628cbd35921c1d54;hpb=ed85afcccb1d054691bcc7ed2242ad0257d251a0;p=sbcl.git

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 640468e..2ffc385 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -317,9 +317,15 @@
           (let ((last (block-last block)))
             (typecase last
               (cif
-               (flush-dest (if-test last))
-               (when (unlink-node last)
-                 (return)))
+               (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)))))
@@ -633,22 +639,25 @@
 	  (convert-if-if use node)
 	  (when (continuation-use test) (return)))))
 
-    (let* ((type (continuation-type test))
-	   (victim
-	    (cond ((constant-continuation-p test)
-		   (if (continuation-value test)
-		       (if-alternative node)
-		       (if-consequent node)))
-		  ((not (types-equal-or-intersect type (specifier-type 'null)))
-		   (if-alternative node))
-		  ((type= type (specifier-type 'null))
-		   (if-consequent node)))))
-      (when victim
-	(flush-dest test)
-	(when (rest (block-succ block))
-	  (unlink-blocks block victim))
-	(setf (component-reanalyze (node-component node)) t)
-	(unlink-node node))))
+    (when (memq (continuation-type-check test)
+                '(nil :deleted))
+      ;; FIXME: Remove the test above when the bug 203 will be fixed.
+      (let* ((type (continuation-type test))
+             (victim
+              (cond ((constant-continuation-p test)
+                     (if (continuation-value test)
+                         (if-alternative node)
+                         (if-consequent node)))
+                    ((not (types-equal-or-intersect type (specifier-type 'null)))
+                     (if-alternative node))
+                    ((type= type (specifier-type 'null))
+                     (if-consequent node)))))
+        (when victim
+          (flush-dest test)
+          (when (rest (block-succ block))
+            (unlink-blocks block victim))
+          (setf (component-reanalyze (node-component node)) t)
+          (unlink-node node)))))
   (values))
 
 ;;; Create a new copy of an IF node that tests the value of the node