diff --git a/src/cmp/cmpenv-fun.lsp b/src/cmp/cmpenv-fun.lsp index 681602d60..479d31ab9 100644 --- a/src/cmp/cmpenv-fun.lsp +++ b/src/cmp/cmpenv-fun.lsp @@ -11,7 +11,7 @@ ;;;; ;;;; See file '../Copyright' for full details. ;;;; -;;;; CMPTYPE-PROP -- Type propagation basic routines and database +;;;; CMPENV-FUN -- Declarations concerning function types and inlining ;;;; (in-package "COMPILER") @@ -159,25 +159,21 @@ (defun inline-possible (fname &optional (env *cmp-env*)) (not (declared-notinline-p fname env))) -;;; Install inline expansion of function. If the function is -;;; PROCLAIMED inline, then we keep a copy of the definition as a -;;; symbol property. If the function is DECLAIMED inline, then we keep -;;; the definition in the compiler environment during compilation and -;;; install it as a symbol property during loading of the compiled -;;; file. -(defun maybe-install-inline-function (fname form env) - (let* ((x (cmp-env-search-declaration 'inline env)) - (flag (assoc fname x :test #'same-fname-p)) - (declared (and flag (cdr flag))) - (proclaimed (sys:get-sysprop fname 'inline))) - `(progn - ,(when declared - `(progn - (eval-when (:compile-toplevel) - (c::declare-inline ',fname *cmp-env-root* ',form)) - (eval-when (:load-toplevel :execute) - (si:put-sysprop ',fname 'inline ',form)))) - ,(when proclaimed - `(eval-when (:compile-toplevel :load-toplevel :execute) - (si:put-sysprop ',fname 'inline ',form)))))) +;;; Install inline expansion of function. +(defun maybe-install-inline-function (fname form) + (when (declared-inline-p fname *cmp-env-root*) + ;; The function was already PROCLAIMED inline and might be + ;; redefined in the file we are currently compiling. Declare it as + ;; inline in the compiler environment and remove the symbol + ;; property so that if we can't inline the new definition (e.g. + ;; because it is a closure) we don't accidentally inline an old + ;; definition from the symbol property. + (declare-inline fname *cmp-env-root*) + (si:rem-sysprop fname 'inline) + ;; If the function is PROCLAIMED or DECLAIMED inline, then we + ;; install the definition as a symbol property during loading of + ;; the compiled file. If the function was only DECLARED inline + ;; locally we don't keep the definition. + `(eval-when (:load-toplevel :execute) + (si:put-sysprop ',fname 'inline ',form)))) diff --git a/src/cmp/cmppass1-call.lsp b/src/cmp/cmppass1-call.lsp index 6435629c3..859049d55 100644 --- a/src/cmp/cmppass1-call.lsp +++ b/src/cmp/cmppass1-call.lsp @@ -116,6 +116,10 @@ (t (default-apply fun arguments)))))) +(defun not-a-closure-p (fname) + (declare (si::c-local)) + (not (and (fboundp fname) (nth-value 1 (function-lambda-expression (fdefinition fname)))))) + (defun c1call (fname args macros-allowed &aux fd success can-inline) (cond ((> (length args) si::c-arguments-limit) (if (and macros-allowed @@ -147,13 +151,19 @@ (setq fd (macro-function fname))) (cmp-expand-macro fd (list* fname args))) ((and (setq can-inline (declared-inline-p fname)) - (consp can-inline) - (eq (first can-inline) 'function) (plusp *inline-max-depth*) (<= (cmp-env-optimization 'space) 1)) - (let ((*inline-max-depth* (1- *inline-max-depth*))) - (cmpnote "Inlining ~a" fname) - `(funcall ,can-inline ,@args))) + (cond ((and (setq fd (find fname *global-funs* :key #'fun-name :test #'same-fname-p)) + (not (fun-closure fd))) + (cmpnote "Inlining ~a" fname) + (inline-local (fun-lambda-expression fd) fd args)) + ((and (consp can-inline) + (not-a-closure-p fname) + (eq (first can-inline) 'function)) + (let ((*inline-max-depth* (1- *inline-max-depth*))) + (cmpnote "Inlining ~a" fname) + `(funcall ,can-inline ,@args))) + (t (c1call-global fname args)))) (t (c1call-global fname args)))) (defun inline-local (lambda fun args) diff --git a/src/lsp/evalmacros.lsp b/src/lsp/evalmacros.lsp index d01350ff1..d66315c31 100644 --- a/src/lsp/evalmacros.lsp +++ b/src/lsp/evalmacros.lsp @@ -90,18 +90,17 @@ VARIABLE doc and can be retrieved by (DOCUMENTATION 'SYMBOL 'VARIABLE)." ',var)) (defparameter *defun-inline-hook* - #'(lambda (fname form env) + #'(lambda (fname form) ;; To prevent inlining of stale function definitions by the native ;; compiler after a new definition has been established by the ;; bytecodes compiler, we save function definitions in the global ;; environment when the function has been proclaimed inline. - (declare (ignore env)) (let ((proclaimed (si:get-sysprop fname 'inline))) (when proclaimed - `(eval-when (:compile-toplevel :load-toplevel :execute) + `(eval-when (:load-toplevel :execute) (si:put-sysprop ',fname 'inline ',form)))))) -(defmacro defun (&whole whole name vl &body body &environment env &aux doc-string) +(defmacro defun (&whole whole name vl &body body &aux doc-string) ;; Documentation in help.lsp (multiple-value-setq (body doc-string) (remove-documentation body)) (let* ((function `#'(ext::lambda-block ,name ,vl ,@body)) @@ -115,7 +114,7 @@ VARIABLE doc and can be retrieved by (DOCUMENTATION 'SYMBOL 'VARIABLE)." ,(ext:register-with-pde whole `(si::fset ',name ,global-function)) ,@(si::expand-set-documentation name 'function doc-string) ,(let ((hook *defun-inline-hook*)) - (and hook (funcall hook name global-function env))) + (and hook (funcall hook name global-function))) ',name))) ;;; diff --git a/src/tests/normal-tests/compiler.lsp b/src/tests/normal-tests/compiler.lsp index 07918293f..c73211e2d 100644 --- a/src/tests/normal-tests/compiler.lsp +++ b/src/tests/normal-tests/compiler.lsp @@ -1874,24 +1874,48 @@ ;; global function in same file, declaimed inline (load (with-compiler ("inline-closure.lsp") '(in-package #:cl-test) - '(declaim (inline set-b.0079 get-b.0079)) + '(declaim (inline set-b.0079a get-b.0079a)) '(let ((b 123)) - (defun set-b.0079 (x) - (setf b x)) - (defun get-b.0079 () b)) - '(defun foo.0079 () + (defun set-b.0079a (x) + (setf b x)) + (defun get-b.0079a () b)) + '(defun foo.0079a () (let (results) - (push (get-b.0079) results) + (push (get-b.0079a) results) (let ((b 345)) - (push (get-b.0079) results) + (push (get-b.0079a) results) (push b results) - (set-b.0079 0) - (push (get-b.0079) results) + (set-b.0079a 0) + (push (get-b.0079a) results) (push b results)) - (push (get-b.0079) results) + (push (get-b.0079a) results) (nreverse results))))) (is (equal - (funcall 'foo.0079) + (funcall 'foo.0079a) + '(123 123 345 0 345 0))) + ;; global function in different file, proclaimed inline + (proclaim '(inline set-b.0079b get-b.0079b)) + (load (with-compiler ("inline-closure-1.lsp") + '(in-package #:cl-test) + '(let ((b 123)) + (defun set-b.0079b (x) + (setf b x)) + (defun get-b.0079b () b)))) + (load (with-compiler ("inline-closure-2.lsp") + '(in-package #:cl-test) + '(defun foo.0079b () + (let (results) + (push (get-b.0079b) results) + (let ((b 345)) + (push (get-b.0079b) results) + (push b results) + (set-b.0079b 0) + (push (get-b.0079b) results) + (push b results)) + (push (get-b.0079b) results) + (nreverse results))))) + (is (equal + (funcall 'foo.0079b) '(123 123 345 0 345 0)))) ;;; Date 2020-05-08 @@ -2112,3 +2136,26 @@ '(eq '#7=((#7# . a) . b) '#8=((#8# . a) . b)) '(eq '#9=((a . #9#) . b) '#10=((a . #10#) . b)) '(eq '#11=(#11# . #11#) '#12=(#12# . #12#))))) + +;;; Date 2022-12-30 +;;; Description +;;; +;;; Check that function redefinitions for functions which are +;;; declared as inline are picked up correctly even if we can't +;;; inline the new definition (e.g. because it is a closure). +;;; +(test cmp.0092.inline-redefinition + (setf (compiler-macro-function 'foo) nil) + (finishes (with-compiler ("inline-redefinition-1.lsp" :load t) + '(declaim (inline foo)) + '(defun foo () 1) + '(defun bar () (foo)))) + (is (eql (bar) 1)) + (finishes (with-compiler ("inline-redefinition-2.lsp" :load t) + '(let ((a 2)) + (defun ensure-compiler-cannot-optimize-away-the-let-statement (x) + (setf a x)) + (defun foo () + a)) + '(defun bar () (foo)))) + (is (eql (bar) 2)))