From c207708c86ab04f4bb1d78789be0d116e77ba9bb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 27 Jun 2012 23:31:27 -0400 Subject: [PATCH] Make inlining of other-mode interpreted functions work. * lisp/emacs-lisp/bytecomp.el (byte-compile--refiy-function): New fun. (byte-compile): Use it to fix compilation of lexical-binding closures. * lisp/emacs-lisp/byte-opt.el (byte-compile-inline-expand): Compile the function, if needed. Fixes: debbugs:11799 --- lisp/ChangeLog | 8 ++++++++ lisp/emacs-lisp/byte-opt.el | 50 +++++++++++++++++---------------------------- lisp/emacs-lisp/bytecomp.el | 41 +++++++++++++++++++++++++++++-------- 3 files changed, 60 insertions(+), 39 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 566dad73cf0..bb7fca91126 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2012-06-28 Stefan Monnier + + Make inlining of other-mode interpreted functions work (bug#11799). + * emacs-lisp/bytecomp.el (byte-compile--refiy-function): New fun. + (byte-compile): Use it to fix compilation of lexical-binding closures. + * emacs-lisp/byte-opt.el (byte-compile-inline-expand): Compile the + function, if needed. + 2012-06-27 Stefan Monnier * help-mode.el (help-make-xrefs): Don't just withstand diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 92a10dff774..106946b0037 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -266,42 +266,30 @@ ;; (message "Inlining byte-code for %S!" name) ;; The byte-code will be really inlined in byte-compile-unfold-bcf. `(,fn ,@(cdr form))) - ((or (and `(lambda ,args . ,body) (let env nil)) - `(closure ,env ,args . ,body)) + ((or `(lambda . ,_) `(closure . ,_)) (if (not (or (eq fn localfn) ;From the same file => same mode. - (eq (not lexical-binding) (not env)))) ;Same mode. + (eq (car fn) ;Same mode. + (if lexical-binding 'closure 'lambda)))) ;; While byte-compile-unfold-bcf can inline dynbind byte-code into ;; letbind byte-code (or any other combination for that matter), we ;; can only inline dynbind source into dynbind source or letbind ;; source into letbind source. - ;; FIXME: we could of course byte-compile the inlined function - ;; first, and then inline its byte-code. - form - (let ((renv ())) - ;; Turn the function's closed vars (if any) into local let bindings. - (dolist (binding env) - (cond - ((consp binding) - ;; We check shadowing by the args, so that the `let' can be - ;; moved within the lambda, which can then be unfolded. - ;; FIXME: Some of those bindings might be unused in `body'. - (unless (memq (car binding) args) ;Shadowed. - (push `(,(car binding) ',(cdr binding)) renv))) - ((eq binding t)) - (t (push `(defvar ,binding) body)))) - (let ((newfn (if (eq fn localfn) - ;; If `fn' is from the same file, it has already - ;; been preprocessed! - `(function ,fn) - (byte-compile-preprocess - (if (null renv) - `(lambda ,args ,@body) - `(lambda ,args (let ,(nreverse renv) ,@body))))))) - (if (eq (car-safe newfn) 'function) - (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form))) - (byte-compile-log-warning - (format "Inlining closure %S failed" name)) - form))))) + (progn + ;; We can of course byte-compile the inlined function + ;; first, and then inline its byte-code. + (byte-compile name) + `(,(symbol-function name) ,@(cdr form))) + (let ((newfn (if (eq fn localfn) + ;; If `fn' is from the same file, it has already + ;; been preprocessed! + `(function ,fn) + (byte-compile-preprocess + (byte-compile--refiy-function fn))))) + (if (eq (car-safe newfn) 'function) + (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form))) + (byte-compile-log-warning + (format "Inlining closure %S failed" name)) + form)))) (t ;; Give up on inlining. form)))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 650faec6bf6..af7bc81fef0 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2451,7 +2451,26 @@ If QUOTED is non-nil, print with quoting; otherwise, print without quoting." (- (position-bytes (point)) (point-min) -1) (goto-char (point-max)))))) - +(defun byte-compile--refiy-function (fun) + "Return an expression which will evaluate to a function value FUN. +FUN should be either a `lambda' value or a `closure' value." + (pcase-let* (((or (and `(lambda ,args . ,body) (let env nil)) + `(closure ,env ,args . ,body)) fun) + (renv ())) + ;; Turn the function's closed vars (if any) into local let bindings. + (dolist (binding env) + (cond + ((consp binding) + ;; We check shadowing by the args, so that the `let' can be moved + ;; within the lambda, which can then be unfolded. FIXME: Some of those + ;; bindings might be unused in `body'. + (unless (memq (car binding) args) ;Shadowed. + (push `(,(car binding) ',(cdr binding)) renv))) + ((eq binding t)) + (t (push `(defvar ,binding) body)))) + (if (null renv) + `(lambda ,args ,@body) + `(lambda ,args (let ,(nreverse renv) ,@body))))) ;;;###autoload (defun byte-compile (form) @@ -2459,23 +2478,29 @@ If QUOTED is non-nil, print with quoting; otherwise, print without quoting." If FORM is a lambda or a macro, byte-compile it as a function." (displaying-byte-compile-warnings (byte-compile-close-variables - (let* ((fun (if (symbolp form) + (let* ((lexical-binding lexical-binding) + (fun (if (symbolp form) (and (fboundp form) (symbol-function form)) form)) (macro (eq (car-safe fun) 'macro))) (if macro (setq fun (cdr fun))) - (cond ((eq (car-safe fun) 'lambda) + (when (symbolp form) + (unless (memq (car-safe fun) '(closure lambda)) + (error "Don't know how to compile %S" fun)) + (setq fun (byte-compile--refiy-function fun)) + (setq lexical-binding (eq (car fun) 'closure))) + (unless (eq (car-safe fun) 'lambda) + (error "Don't know how to compile %S" fun)) ;; Expand macros. (setq fun (byte-compile-preprocess fun)) ;; Get rid of the `function' quote added by the `lambda' macro. (if (eq (car-safe fun) 'function) (setq fun (cadr fun))) - (setq fun (if macro - (cons 'macro (byte-compile-lambda fun)) - (byte-compile-lambda fun))) + (setq fun (byte-compile-lambda fun)) + (if macro (push 'macro fun)) (if (symbolp form) - (defalias form fun) - fun))))))) + (fset form fun) + fun))))) (defun byte-compile-sexp (sexp) "Compile and return SEXP." -- 2.11.4.GIT