From: Stefan Monnier Date: Mon, 1 Dec 2014 14:45:15 +0000 (-0500) Subject: New macro `define-inline'. X-Git-Tag: emacs-25.0.90~2635^2~258 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f0e8c1eac226641ea8acab9e0f47ce3541803f0d;p=emacs.git New macro `define-inline'. * lisp/emacs-lisp/inline.el: New file. --- diff --git a/etc/NEWS b/etc/NEWS index 9c34bb29903..6c636cf3095 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -373,6 +373,8 @@ Emacs-21. * Lisp Changes in Emacs 25.1 +** define-inline provides a new way to define inlinable functions. + ** New function macroexpand-1 to perform a single step of macroexpansion. ** Some "x-*" were obsoleted: diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d6691f51d17..41b3ddbc3aa 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,9 +1,13 @@ +2014-12-01 Stefan Monnier + + * emacs-lisp/inline.el: New file. + 2014-12-01 Eric S. Raymond * vc/vc.el, vc-hooks.el, and all backends: API simplification; vc-state-heuristic is no longer a public method, having been - removed where it is redundant, unnecessary, or known buggy. This - eliminated all backends except CVS. Eliminates bug#7850. + removed where it is redundant, unnecessary, or known buggy. + This eliminated all backends except CVS. Eliminates bug#7850. * vc/vc-cvs.el, vc/vc-hooks.el, vc/vc-rcs.el, vc/vc-sccs.el: Eliminate vc-mistrust-permissions. It was only relevant to the @@ -41,8 +45,8 @@ 2014-11-29 Fabián Ezequiel Gallina - * progmodes/python.el (python-shell-completion-setup-code): Use - __builtin__ module (or builtins in Python 3) and catch all errors + * progmodes/python.el (python-shell-completion-setup-code): + Use __builtin__ module (or builtins in Python 3) and catch all errors when importing readline and rlcompleter. 2014-11-29 Stephen Berman @@ -94,8 +98,8 @@ 2014-11-29 Eli Zaretskii - * vc/vc-git.el (vc-git-command, vc-git--call): Bind - coding-system-for-read and coding-system-for-write to + * vc/vc-git.el (vc-git-command, vc-git--call): + Bind coding-system-for-read and coding-system-for-write to vc-git-commits-coding-system. (vc-git-previous-revision): Use "~1" instead of "^", since the latter is a special character for MS-Windows system shells. diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 38956df66de..01f59704a39 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -120,7 +120,8 @@ expression, in which case we want to handle forms differently." ;; Look for an interactive spec. (interactive (pcase body ((or `((interactive . ,_) . ,_) - `(,_ (interactive . ,_) . ,_)) t)))) + `(,_ (interactive . ,_) . ,_)) + t)))) ;; Add the usage form at the end where describe-function-1 ;; can recover it. (when (listp args) (setq doc (help-add-fundoc-usage doc args))) @@ -140,11 +141,9 @@ expression, in which case we want to handle forms differently." ;; For complex cases, try again on the macro-expansion. ((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode define-globalized-minor-mode defun defmacro - ;; FIXME: we'd want `defmacro*' here as well, so as - ;; to handle its `declare', but when autoload is run - ;; CL is not loaded so macroexpand doesn't know how - ;; to expand it! - easy-mmode-define-minor-mode define-minor-mode)) + easy-mmode-define-minor-mode define-minor-mode + define-inline cl-defun cl-defmacro)) + (macrop car) (setq expand (let ((load-file-name file)) (macroexpand form))) (memq (car expand) '(progn prog1 defalias))) (make-autoload expand file 'expansion)) ;Recurse on the expansion. diff --git a/lisp/emacs-lisp/inline.el b/lisp/emacs-lisp/inline.el new file mode 100644 index 00000000000..3f11781aec0 --- /dev/null +++ b/lisp/emacs-lisp/inline.el @@ -0,0 +1,251 @@ +;;; inline.el --- Define functions by their inliner -*- lexical-binding:t; -*- + +;; Copyright (C) 2014 Stefan Monnier + +;; Author: Stefan Monnier + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This package provides the macro `define-inline' which lets you define +;; functions by defining their (exhaustive) compiler macro. +;; +;; The idea is that instead of doing like defsubst and cl-defsubst (i.e. from +;; the function's definition, guess the best way to inline the function), +;; we go the other way around: the programmer provides the code that does the +;; inlining (as a compiler-macro) and from that we derive the definition of the +;; function itself. The idea originated in an attempt to clean up `cl-typep', +;; whose function definition amounted to (eval (cl--make-type-test EXP TYPE)). +;; +;; The simplest use is for plain and simple inlinable functions. Rather than: +;; +;; (defmacro myaccessor (obj) +;; (macroexp-let2 macroexp-copyable-p obj obj +;; `(if (foop ,obj) (aref (cdr ,obj) 3) (aref ,obj 2)))) +;; Or +;; (defsubst myaccessor (obj) +;; (if (foop obj) (aref (cdr obj) 3) (aref obj 2))) +;; Or +;; (cl-defsubst myaccessor (obj) +;; (if (foop obj) (aref (cdr obj) 3) (aref obj 2))) +;; +;; You'd do +;; +;; (define-inline myaccessor (obj) +;; (inline-letevals (obj) +;; (inline-quote (if (foop ,obj) (aref (cdr ,obj) 3) (aref ,obj 2))))) +;; +;; Other than verbosity, you get the best of all 3 above without their +;; respective downsides: +;; - defmacro: can't be passed to `mapcar' since it's not a function. +;; - defsubst: not as efficient, and doesn't work as a `gv' place. +;; - cl-defsubst: only works by accident, since it has latent bugs in its +;; handling of variables and scopes which could bite you at any time. +;; (e.g. try (cl-defsubst my-test1 (x) (let ((y 5)) (+ x y))) +;; and then M-: (macroexpand-all '(my-test1 y)) RET) +;; There is still one downside shared with the defmacro and cl-defsubst +;; approach: when the function is inlined, the scoping rules (dynamic or +;; lexical) will be inherited from the the call site. + +;; Of course, since define-inline defines a compiler macro, you can also do +;; call-site optimizations, just like you can with `defmacro', but not with +;; defsubst nor cl-defsubst. + +;;; Code: + +(require 'macroexp) + +(defmacro inline-quote (exp) + "Similar to backquote, but quotes code and only accepts , and not ,@." + (declare (debug t)) + (error "inline-quote can only be used within define-inline")) + +(defmacro inline-const-p (exp) + "Return non-nil if the value of EXP is already known." + (declare (debug t)) + (error "inline-const-p can only be used within define-inline")) + +(defmacro inline-const-val (exp) + "Return the value of EXP." + (declare (debug t)) + (error "inline-const-val can only be used within define-inline")) + +(defmacro inline-error (format &rest args) + "Signal an error." + (declare (debug t)) + (error "inline-error can only be used within define-inline")) + +(defmacro inline--leteval (_var-exp &rest _body) + (declare (indent 1) (debug (sexp &rest body))) + (error "inline-letevals can only be used within define-inline")) +(defmacro inline--letlisteval (_list &rest _body) + (declare (indent 1) (debug (sexp &rest body))) + (error "inline-letevals can only be used within define-inline")) + +(defmacro inline-letevals (vars &rest body) + "Make sure the expressions in VARS are evaluated. +VARS should be a list of elements of the form (VAR EXP) or just VAR, in case +EXP is equal to VAR. The result is to evaluate EXP and bind the result to VAR. + +The tail of VARS can be either nil or a symbol VAR which should hold a list +of arguments,in which case each argument is evaluated and the resulting +new list is re-bound to VAR. + +After VARS is handled, BODY is evaluated in the new environment." + (declare (indent 1) (debug (sexp &rest body))) + (cond + ((consp vars) + `(inline--leteval ,(pop vars) (inline-letevals ,vars ,@body))) + (vars + `(inline--letlisteval ,vars ,@body)) + (t (macroexp-progn body)))) + + +;;;###autoload +(defmacro define-inline (name args &rest body) + ;; FIXME: How can this work with CL arglists? + (declare (indent defun) (debug defun) (doc-string 3)) + (let ((doc (if (stringp (car-safe body)) (list (pop body)))) + (declares (if (eq (car-safe (car-safe body)) 'declare) (pop body))) + (cm-name (intern (format "%s--inliner" name))) + (bodyexp (macroexp-progn body))) + ;; If the function is autoloaded then when we load the .el file, the + ;; `compiler-macro' property is already set (from loaddefs.el) and might + ;; hence be called during the macroexpand-all calls below (if the function + ;; is recursive). + ;; So we disable any pre-loaded compiler-macro setting to avoid this. + (function-put name 'compiler-macro nil) + `(progn + (defun ,name ,args + ,@doc + (declare (compiler-macro ,cm-name) ,@(cdr declares)) + ,(macroexpand-all bodyexp + `((inline-quote . inline--dont-quote) + ;; (inline-\` . inline--dont-quote) + (inline--leteval . inline--dont-leteval) + (inline--letlisteval . inline--dont-letlisteval) + (inline-const-p . inline--alwaysconst-p) + (inline-const-val . inline--alwaysconst-val) + (inline-error . inline--error) + ,@macroexpand-all-environment))) + :autoload-end + (eval-and-compile + (defun ,cm-name ,(cons 'inline--form args) + (ignore inline--form) ;In case it's not used! + (catch 'inline--just-use + ,(macroexpand-all + bodyexp + `((inline-quote . inline--do-quote) + ;; (inline-\` . inline--do-quote) + (inline--leteval . inline--do-leteval) + (inline--letlisteval + . inline--do-letlisteval) + (inline-const-p . inline--testconst-p) + (inline-const-val . inline--getconst-val) + (inline-error . inline--warning) + ,@macroexpand-all-environment)))))))) + +(defun inline--do-quote (exp) + (pcase exp + (`(,'\, ,e) e) ;Eval `e' now *and* later. + (`'(,'\, ,e) `(list 'quote ,e)) ;Only eval `e' now, not later. + (`#'(,'\, ,e) `(list 'function ,e)) ;Only eval `e' now, not later. + ((pred consp) + (let ((args ())) + (while (and (consp exp) (not (eq '\, (car exp)))) + (push (inline--do-quote (pop exp)) args)) + (setq args (nreverse args)) + (if exp + `(backquote-list* ,@args ,(inline--do-quote exp)) + `(list ,@args)))) + (_ (macroexp-quote exp)))) + +(defun inline--dont-quote (exp) + (pcase exp + (`(,'\, ,e) e) + (`'(,'\, ,e) e) + (`#'(,'\, ,e) e) + ((pred consp) + (let ((args ())) + (while (and (consp exp) (not (eq '\, (car exp)))) + (push (inline--dont-quote (pop exp)) args)) + (setq args (nreverse args)) + (if exp + `(apply ,@args ,(inline--dont-quote exp)) + args))) + (_ exp))) + +(defun inline--do-leteval (var-exp &rest body) + `(macroexp-let2 ,(if (symbolp var-exp) #'macroexp-copyable-p #'ignore) + ,(or (car-safe var-exp) var-exp) + ,(or (car (cdr-safe var-exp)) var-exp) + ,@body)) + +(defun inline--dont-leteval (var-exp &rest body) + (if (symbolp var-exp) + (macroexp-progn body) + `(let (,var-exp) ,@body))) + +(defun inline--do-letlisteval (listvar &rest body) + ;; Here's a sample situation: + ;; (define-inline foo (arg &rest keys) + ;; (inline-letevals (arg . keys) + ;; )) + ;; I.e. in we need `keys' to contain a list of + ;; macroexp-copyable-p expressions. + (let ((bsym (make-symbol "bindings"))) + `(let* ((,bsym ()) + (,listvar (mapcar (lambda (e) + (if (macroexp-copyable-p e) e + (let ((v (make-symbol "v"))) + (push (list v e) ,bsym) + v))) + ,listvar))) + (macroexp-let* (nreverse ,bsym) + ,(macroexp-progn body))))) + +(defun inline--dont-letlisteval (_listvar &rest body) + (macroexp-progn body)) + +(defun inline--testconst-p (exp) + `(macroexp-const-p ,exp)) + +(defun inline--alwaysconst-p (_exp) + t) + +(defun inline--getconst-val (exp) + (macroexp-let2 macroexp-copyable-p exp exp + `(cond + ((not (macroexp-const-p ,exp)) + (throw 'inline--just-use inline--form)) + ((consp ,exp) (cadr ,exp)) + (t ,exp)))) + +(defun inline--alwaysconst-val (exp) + exp) + +(defun inline--error (&rest args) + `(error ,@args)) + +(defun inline--warning (&rest _args) + `(throw 'inline--just-use + ;; FIXME: This would inf-loop by calling us right back when + ;; macroexpand-all recurses to expand inline--form. + ;; (macroexp--warn-and-return (format ,@args) + ;; inline--form) + inline--form)) + +(provide 'inline) +;;; inline.el ends here