lisp/emacs-lisp/inline.el

   1 ;;; inline.el --- Define functions by their inliner  -*- lexical-binding:t; -*-
   2
   3 ;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
   4
   5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; This package provides the macro `define-inline' which lets you define
  25 ;; functions by defining their (exhaustive) compiler macro.
  26 ;;
  27 ;; The idea is that instead of doing like defsubst and cl-defsubst (i.e. from
  28 ;; the function's definition, guess the best way to inline the function),
  29 ;; we go the other way around: the programmer provides the code that does the
  30 ;; inlining (as a compiler-macro) and from that we derive the definition of the
  31 ;; function itself.  The idea originated in an attempt to clean up `cl-typep',
  32 ;; whose function definition amounted to (eval (cl--make-type-test EXP TYPE)).
  33 ;;
  34 ;; The simplest use is for plain and simple inlinable functions.  Rather than:
  35 ;;
  36 ;;     (defmacro myaccessor (obj)
  37 ;;       (macroexp-let2 macroexp-copyable-p obj obj
  38 ;;         `(if (foop ,obj) (aref (cdr ,obj) 3) (aref ,obj 2))))
  39 ;; Or
  40 ;;     (defsubst myaccessor (obj)
  41 ;;       (if (foop obj) (aref (cdr obj) 3) (aref obj 2)))
  42 ;; Or
  43 ;;     (cl-defsubst myaccessor (obj)
  44 ;;       (if (foop obj) (aref (cdr obj) 3) (aref obj 2)))
  45 ;;
  46 ;; You'd do
  47 ;;
  48 ;;     (define-inline myaccessor (obj)
  49 ;;       (inline-letevals (obj)
  50 ;;         (inline-quote (if (foop ,obj) (aref (cdr ,obj) 3) (aref ,obj 2)))))
  51 ;;
  52 ;; Other than verbosity, you get the best of all 3 above without their
  53 ;; respective downsides:
  54 ;; - defmacro: can't be passed to `mapcar' since it's not a function.
  55 ;; - defsubst: not as efficient, and doesn't work as a `gv' place.
  56 ;; - cl-defsubst: only works by accident, since it has latent bugs in its
  57 ;;   handling of variables and scopes which could bite you at any time.
  58 ;;   (e.g. try (cl-defsubst my-test1 (x) (let ((y 5)) (+ x y)))
  59 ;;         and then M-: (macroexpand-all '(my-test1 y)) RET)
  60 ;; There is still one downside shared with the defmacro and cl-defsubst
  61 ;; approach: when the function is inlined, the scoping rules (dynamic or
  62 ;; lexical) will be inherited from the the call site.
  63
  64 ;; Of course, since define-inline defines a compiler macro, you can also do
  65 ;; call-site optimizations, just like you can with `defmacro', but not with
  66 ;; defsubst nor cl-defsubst.
  67
  68 ;;; Code:
  69
  70 (require 'macroexp)
  71
  72 (defmacro inline-quote (_exp)
  73   "Similar to backquote, but quotes code and only accepts , and not ,@."
  74   (declare (debug t))
  75   (error "inline-quote can only be used within define-inline"))
  76
  77 (defmacro inline-const-p (_exp)
  78   "Return non-nil if the value of EXP is already known."
  79   (declare (debug t))
  80   (error "inline-const-p can only be used within define-inline"))
  81
  82 (defmacro inline-const-val (_exp)
  83   "Return the value of EXP."
  84   (declare (debug t))
  85   (error "inline-const-val can only be used within define-inline"))
  86
  87 (defmacro inline-error (_format &rest _args)
  88   "Signal an error."
  89   (declare (debug t))
  90   (error "inline-error can only be used within define-inline"))
  91
  92 (defmacro inline--leteval (_var-exp &rest _body)
  93   (declare (indent 1) (debug (sexp &rest body)))
  94   (error "inline-letevals can only be used within define-inline"))
  95 (defmacro inline--letlisteval (_list &rest _body)
  96   (declare (indent 1) (debug (sexp &rest body)))
  97   (error "inline-letevals can only be used within define-inline"))
  98
  99 (defmacro inline-letevals (vars &rest body)
 100   "Make sure the expressions in VARS are evaluated.
 101 VARS should be a list of elements of the form (VAR EXP) or just VAR, in case
 102 EXP is equal to VAR.  The result is to evaluate EXP and bind the result to VAR.
 103
 104 The tail of VARS can be either nil or a symbol VAR which should hold a list
 105 of arguments, in which case each argument is evaluated and the resulting
 106 new list is re-bound to VAR.
 107
 108 After VARS is handled, BODY is evaluated in the new environment."
 109   (declare (indent 1) (debug (sexp &rest form)))
 110   (cond
 111    ((consp vars)
 112     `(inline--leteval ,(pop vars) (inline-letevals ,vars ,@body)))
 113    (vars
 114     `(inline--letlisteval ,vars ,@body))
 115    (t (macroexp-progn body))))
 116
 117 ;; (defmacro inline-if (testfun testexp then else)
 118 ;;   (declare (indent 2) (debug (sexp symbolp form form)))
 119 ;;   (macroexp-let2 macroexp-copyable-p testsym testexp
 120 ;;     `(if (inline-const-p ,testexp)
 121 ;;          (if (,testfun (inline-const-val ,testexp)) ,then ,else)
 122 ;;        (inline-quote (if (,testfun ,testexp) ,(list '\, then)
 123 ;;                         ,(list '\, else))))))
 124
 125 ;;;###autoload
 126 (defmacro define-inline (name args &rest body)
 127   ;; FIXME: How can this work with CL arglists?
 128   (declare (indent defun) (debug defun) (doc-string 3))
 129   (let ((doc (if (stringp (car-safe body)) (list (pop body))))
 130         (declares (if (eq (car-safe (car-safe body)) 'declare) (pop body)))
 131         (cm-name (intern (format "%s--inliner" name)))
 132         (bodyexp (macroexp-progn body)))
 133     ;; If the function is autoloaded then when we load the .el file, the
 134     ;; `compiler-macro' property is already set (from loaddefs.el) and might
 135     ;; hence be called during the macroexpand-all calls below (if the function
 136     ;; is recursive).
 137     ;; So we disable any pre-loaded compiler-macro setting to avoid this.
 138     (function-put name 'compiler-macro nil)
 139     `(progn
 140        (defun ,name ,args
 141          ,@doc
 142          (declare (compiler-macro ,cm-name) ,@(cdr declares))
 143          ,(macroexpand-all bodyexp
 144                            `((inline-quote . inline--dont-quote)
 145                              ;; (inline-\` . inline--dont-quote)
 146                              (inline--leteval . inline--dont-leteval)
 147                              (inline--letlisteval . inline--dont-letlisteval)
 148                              (inline-const-p . inline--alwaysconst-p)
 149                              (inline-const-val . inline--alwaysconst-val)
 150                              (inline-error . inline--error)
 151                              ,@macroexpand-all-environment)))
 152        :autoload-end
 153        (eval-and-compile
 154          (defun ,cm-name ,(cons 'inline--form args)
 155            (ignore inline--form)     ;In case it's not used!
 156            (catch 'inline--just-use
 157              ,(macroexpand-all
 158                bodyexp
 159                `((inline-quote . inline--do-quote)
 160                  ;; (inline-\` . inline--do-quote)
 161                  (inline--leteval . inline--do-leteval)
 162                  (inline--letlisteval
 163                   . inline--do-letlisteval)
 164                  (inline-const-p . inline--testconst-p)
 165                  (inline-const-val . inline--getconst-val)
 166                  (inline-error . inline--warning)
 167                  ,@macroexpand-all-environment))))))))
 168
 169 (defun inline--do-quote (exp)
 170   (pcase exp
 171     (`(,'\, ,e) e)                      ;Eval `e' now *and* later.
 172     (`'(,'\, ,e) `(list 'quote ,e))     ;Only eval `e' now, not later.
 173     (`#'(,'\, ,e) `(list 'function ,e)) ;Only eval `e' now, not later.
 174     ((pred consp)
 175      (let ((args ()))
 176        (while (and (consp exp) (not (eq '\, (car exp))))
 177          (push (inline--do-quote (pop exp)) args))
 178        (setq args (nreverse args))
 179        (if exp
 180            `(backquote-list* ,@args ,(inline--do-quote exp))
 181          `(list ,@args))))
 182     (_ (macroexp-quote exp))))
 183
 184 (defun inline--dont-quote (exp)
 185   (pcase exp
 186     (`(,'\, ,e) e)
 187     (`'(,'\, ,e) e)
 188     (`#'(,'\, ,e) e)
 189     ((pred consp)
 190      (let ((args ()))
 191        (while (and (consp exp) (not (eq '\, (car exp))))
 192          (push (inline--dont-quote (pop exp)) args))
 193        (setq args (nreverse args))
 194        (if (null exp)
 195            args
 196          `(apply #',(car args) ,@(cdr args) ,(inline--dont-quote exp)))))
 197     (_ exp)))
 198
 199 (defun inline--do-leteval (var-exp &rest body)
 200   `(macroexp-let2 ,(if (symbolp var-exp) #'macroexp-copyable-p #'ignore)
 201        ,(or (car-safe var-exp) var-exp)
 202        ,(or (car (cdr-safe var-exp)) var-exp)
 203      ,@body))
 204
 205 (defun inline--dont-leteval (var-exp &rest body)
 206   (if (symbolp var-exp)
 207       (macroexp-progn body)
 208     `(let (,var-exp) ,@body)))
 209
 210 (defun inline--do-letlisteval (listvar &rest body)
 211   ;; Here's a sample situation:
 212   ;; (define-inline foo (arg &rest keys)
 213   ;;   (inline-letevals (arg . keys)
 214   ;;      <check-keys>))
 215   ;; I.e. in <check-keys> we need `keys' to contain a list of
 216   ;; macroexp-copyable-p expressions.
 217   (let ((bsym (make-symbol "bindings")))
 218     `(let* ((,bsym ())
 219             (,listvar (mapcar (lambda (e)
 220                                 (if (macroexp-copyable-p e) e
 221                                   (let ((v (make-symbol "v")))
 222                                     (push (list v e) ,bsym)
 223                                     v)))
 224                               ,listvar)))
 225        (macroexp-let* (nreverse ,bsym)
 226                       ,(macroexp-progn body)))))
 227
 228 (defun inline--dont-letlisteval (_listvar &rest body)
 229   (macroexp-progn body))
 230
 231 (defun inline--testconst-p (exp)
 232   (macroexp-let2 macroexp-copyable-p exp exp
 233     `(or (macroexp-const-p ,exp)
 234          (eq (car-safe ,exp) 'function))))
 235
 236 (defun inline--alwaysconst-p (_exp)
 237   t)
 238
 239 (defun inline--getconst-val (exp)
 240   (macroexp-let2 macroexp-copyable-p exp exp
 241     `(cond
 242       ((not ,(inline--testconst-p exp))
 243        (throw 'inline--just-use inline--form))
 244       ((consp ,exp) (cadr ,exp))
 245       (t ,exp))))
 246
 247 (defun inline--alwaysconst-val (exp)
 248   exp)
 249
 250 (defun inline--error (&rest args)
 251   `(error ,@args))
 252
 253 (defun inline--warning (&rest _args)
 254   `(throw 'inline--just-use
 255           ;; FIXME: This would inf-loop by calling us right back when
 256           ;; macroexpand-all recurses to expand inline--form.
 257           ;; (macroexp--warn-and-return (format ,@args)
 258           ;;                            inline--form)
 259           inline--form))
 260
 261 (provide 'inline)
 262 ;;; inline.el ends here