0.8alpha.0.8:

[sbcl.git] / src / compiler / ir1util.lisp

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 6805e4f..690cc2a 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -1247,6 +1247,15 @@
          (setf (continuation-asserted-type cont) *wild-type*)
           (setf (continuation-type-to-check cont) *wild-type*)
          (values))))))
+
+(defun flush-combination (combination)
+  (declare (type combination combination))
+  (flush-dest (combination-fun combination))
+  (dolist (arg (combination-args combination))
+    (flush-dest arg))
+  (unlink-node combination)
+  (values))
+
 \f
 ;;;; leaf hackery
 
@@ -1259,7 +1268,10 @@
     (setf (ref-leaf ref) leaf)
     (setf (leaf-ever-used leaf) t)
     (let ((ltype (leaf-type leaf)))
-      (if (fun-type-p ltype)
+      (if (let* ((cont (node-cont ref))
+                 (dest (continuation-dest cont)))
+            (and (basic-combination-p dest)
+                 (eq cont (basic-combination-fun dest))))
          (setf (node-derived-type ref) ltype)
          (derive-node-type ref ltype)))
     (reoptimize-continuation (node-cont ref)))