1.0.47.13: extend LVAR-FUN-IS to constant functions and function names

  Allows optizing eg. (MEMBER X Y :TEST 'EQ) unlike the previous one.

  Additionally make the code work like the comment says, and return
  true only if the function is not NOTINLINE.

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 78d92e3..55df159 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -2210,17 +2210,35 @@ is :ANY, the function name is not checked."
                (setf (block-reoptimize (node-block node)) t)
                (reoptimize-component (node-component node) :maybe)))))))
 
-;;; Return true if LVAR's only use is a non-NOTINLINE reference to a
-;;; global function with one of the specified NAMES.
+;;; Return true if LVAR's only use is a reference to a global function
+;;; designator with one of the specified NAMES, that hasn't been
+;;; declared NOTINLINE.
 (defun lvar-fun-is (lvar names)
   (declare (type lvar lvar) (list names))
   (let ((use (lvar-uses lvar)))
     (and (ref-p use)
-         (let ((leaf (ref-leaf use)))
-           (and (global-var-p leaf)
-                (eq (global-var-kind leaf) :global-function)
-                (not (null (member (leaf-source-name leaf) names
-                                   :test #'equal))))))))
+         (let* ((*lexenv* (node-lexenv use))
+                (leaf (ref-leaf use))
+                (name
+                 (cond ((global-var-p leaf)
+                        ;; Case 1: #'NAME
+                        (and (eq (global-var-kind leaf) :global-function)
+                             (car (member (leaf-source-name leaf) names
+                                          :test #'equal))))
+                       ((constant-p leaf)
+                        (let ((value (constant-value leaf)))
+                          (car (if (functionp value)
+                                   ;; Case 2: #.#'NAME
+                                   (member value names
+                                           :key (lambda (name)
+                                                  (and (fboundp name)
+                                                       (fdefinition name)))
+                                           :test #'eq)
+                                   ;; Case 3: 'NAME
+                                   (member value names
+                                           :test #'equal))))))))
+           (and name
+                (not (fun-lexically-notinline-p name)))))))
 
 ;;; Return true if LVAR's only use is a call to one of the named functions
 ;;; (or any function if none are specified) with the specified number of

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 57191fc..c526464 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3791,3 +3791,25 @@
                                    (f (mod a e))))
                                s)))
                       (g a)))))
+
+;;; This doesn't test LVAR-FUN-IS directly, but captures it
+;;; pretty accurately anyways.
+(with-test (:name :lvar-fun-is)
+  (dolist (fun (list
+                (lambda (x) (member x x :test #'eq))
+                (lambda (x) (member x x :test 'eq))
+                (lambda (x) (member x x :test #.#'eq))))
+    (assert (equal (list #'sb-kernel:%member-eq)
+                   (ctu:find-named-callees fun))))
+  (dolist (fun (list
+                (lambda (x)
+                  (declare (notinline eq))
+                  (member x x :test #'eq))
+                (lambda (x)
+                  (declare (notinline eq))
+                  (member x x :test 'eq))
+                (lambda (x)
+                  (declare (notinline eq))
+                  (member x x :test #.#'eq))))
+    (assert (member #'sb-kernel:%member-test
+                    (ctu:find-named-callees fun)))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 9f9c427..05ddb06 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -20,4 +20,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.47.12"
+"1.0.47.13"