X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fir1util.lisp;h=e41c094bb66a4170fe50bab32a5133bf57474dbd;hb=f8893c7c658bf9d9e0757c63e47af2fdea810f04;hp=57caf17c70cd3ac56aee4b4c0ccc1ff5dc48801a;hpb=5af8c2ae56df139842270bd9c9605c5d4b2d5148;p=sbcl.git

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 57caf17..e41c094 100644
--- 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)))))))))
 
 ;;;; careful call