0.8.5.3:

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

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 57caf17..e41c094 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -324,6 +324,13 @@
 (defun node-dest (node)
   (awhen (node-lvar node) (lvar-dest it)))
 
+;;; Checks whether NODE is in a block to be deleted
+(declaim (inline node-to-be-deleted-p))
+(defun node-to-be-deleted-p (node)
+  (let ((block (node-block node)))
+    (or (block-delete-p block)
+        (eq (functional-kind (block-home-lambda block)) :deleted))))
+
 (declaim (ftype (sfunction (clambda) cblock) lambda-block))
 (defun lambda-block (clambda)
   (node-block (lambda-bind clambda)))
@@ -1514,6 +1521,18 @@
               ;; LET-converted functionals are even worse.
               (eql (functional-kind functional) :deleted)))
     (throw 'locall-already-let-converted functional)))
+
+(defun call-full-like-p (call)
+  (declare (type combination call))
+  (let ((kind (basic-combination-kind call)))
+    (or (eq kind :full)
+        (and (fun-info-p kind)
+             (not (fun-info-ir2-convert kind))
+             (dolist (template (fun-info-templates kind) t)
+               (when (eq (template-ltn-policy template) :fast-safe)
+                 (multiple-value-bind (val win)
+                     (valid-fun-use call (template-type template))
+                   (when (or val (not win)) (return nil)))))))))
 \f
 ;;;; careful call