From c02501b9bbd01f1c0c0e896dc5cdb7657a77e4a7 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Thu, 7 Apr 2011 13:02:02 +0000 Subject: [PATCH] 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. --- src/compiler/ir1util.lisp | 32 +++++++++++++++++++++++++------- tests/compiler.pure.lisp | 22 ++++++++++++++++++++++ version.lisp-expr | 2 +- 3 files changed, 48 insertions(+), 8 deletions(-) diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index 78d92e3..55df159 100644 --- 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 --- 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 --- 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" -- 1.7.10.4