1.0.15.9: further ASSOC & MEMBER transform improvements

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

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index f8091af..bd3c298 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -1859,3 +1859,15 @@
                (setf (node-reoptimize node) t)
                (setf (block-reoptimize (node-block node)) t)
                (reoptimize-component (node-component node) :maybe)))))))
+
+;;; True if LVAR is for 'NAME, or #'NAME (global, not local)
+(defun lvar-for-named-function (lvar name)
+  (if (constant-lvar-p lvar)
+      (eq name (lvar-value lvar))
+      (let ((use (lvar-uses lvar)))
+        (and (not (listp use))
+             (ref-p use)
+             (let ((leaf (ref-leaf use)))
+               (and (global-var-p leaf)
+                    (eq :global-function (global-var-kind leaf))
+                    (eq name (leaf-source-name leaf))))))))