New macro `define-inline'.

* lisp/emacs-lisp/inline.el: New file.

4 files changed, 268 insertions, 12 deletions

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  <monnier@iro.umontreal.ca>
+
+        * emacs-lisp/inline.el: New file.
+
 2014-12-01  Eric S. Raymond  <esr@snark.thyrsus.com>
 
         * 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  <fgallina@gnu.org>
 
-        * 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  <stephen.berman@gmx.net>
@@ -94,8 +98,8 @@
 
 2014-11-29  Eli Zaretskii  <eliz@gnu.org>
 
-        * 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 <monnier@iro.umontreal.ca>
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; 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)
+  ;;      <check-keys>))
+  ;; I.e. in <check-keys> 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