From: Lynn Winebarger <owinebar@gmail.com>
To: emacs-devel <emacs-devel@gnu.org>
Subject: define-inline-pure
Date: Fri, 12 May 2023 21:02:54 -0400 [thread overview]
Message-ID: <CAM=F=bC9frotw5k3gHAbyk+U9WTkPwMDYSceiQ=PEgq8MOuwPA@mail.gmail.com> (raw)
I adapted the define-inline function to allow redefinition of existing
function names to be an inlining version that will evaluate constant
arguments during macroexpand-all, without involvement of the compiler.
The code is below this message.
For example, for a truly pure function
(define-inline-pure-subr + (&rest numbers-or-markers))
It can also be used for not-quite-pure functions that may still be
desirable to evaluate at compile-time using an explicit inline-*
variant:
(define-inline-pure-subr format (string &rest objects) inline-format)
There is code following the definition of define-inline-pure-subr to
find all function symbols declared pure and perform the redefinition
on them. Emacs doesn't immediately fail when I run it, but I haven't
recompiled emacs with the code added to inline.el.
At the bottom is a variant of define-inline, define-inline-pure, that
replicates define-inline, except it evaluates the function call during
macroexpansion if all arguments expand to constant expressions. I
have not tested it at all.
The envisioned use case is dispatching macros to generic functions to
get specialization at compile-time. Presumably the byte-compiler's
optimization code might be slightly simplified as well.
Lynn
;;; -*- lexical-binding: t; -*-
(defun inline-extract-arglist (fxn-name)
"Construct arglist based on FXN docstring if provided in help format."
(let* ((s (documentation fxn-name t))
(found (string-match "\n(fn \\([^\)]*\\))$" s))
(n (length "\n\(fn ")))
(if (not found)
;; punt
'(&rest args)
(let ((arglist-string
(format "\(%s"
(downcase (substring s (+ found n))))))
(with-temp-buffer
(insert arglist-string)
(goto-char (point-min))
(read (current-buffer)))))))
(defun inline-application-form (fxn args)
"Construct an application form for function FXN with argument list ARGS."
(let ((ls args)
(required 0)
params opt restp)
(while ls
(pcase ls
(`(&rest ,param)
(push param params)
(setq restp t)
(setq ls nil))
(`(&rest . ,ignored)
(error "argument list: %s: malformed &rest parameter %S" fxn args))
(`(&optional . ,ignored)
(when opt
(error "argument list: %s: multiple &optional markers %S"
fxn args))
(pop ls)
(setq opt 0))
(`(,param . ,ignored)
(push param params)
(pop ls)
(if opt
(setq opt (1+ opt))
(setq required (1+ required))))
(_
(error "malformed argument list: %s: %S" name args))))
(setq params (nreverse params))
(unless opt
(setq opt 0))
(if restp
`(apply ,fxn ,@params)
`(,fxn ,@params))))
;; Derived from inline.el
(defun inline--testconst-exp-p (exp)
(or (macroexp-const-p exp)
(eq (car-safe exp) 'function)))
(defmacro define-inline-pure-subr (name args &optional new-name)
"Define NEW-NAME to inline the subr currently bound to NAME.
The function must have the signature specified by ARGS.
This inlining enables compile-time evaluation during macroexpansion
rather than during the byte-compiler's optimization phase.
NEW-NAME defaults to NAME."
(declare (indent defun) (debug defun) (doc-string 3))
(when (and new-name (not (eq new-name name)))
(setplist new-name (seq-copy (symbol-plist name))))
(unless new-name
(setq new-name name))
(let ((doc (documentation name t))
(fxn (symbol-function name))
(cm-name (intern (format "%s--inliner" new-name)))
app-form)
(while (symbolp fxn)
(setq fxn (symbol-function fxn)))
(function-put new-name 'compiler-macro nil) ; see define-inline
(setq app-form (inline-application-form fxn args))
`(progn
(,(if (memq (get name 'byte-optimizer)
'(nil byte-compile-inline-expand))
'defsubst
'defun)
,new-name ,args ,doc
(declare (compiler-macro ,cm-name))
,app-form)
(eval-and-compile
(defun ,cm-name ,(cons 'inline--form args)
(let* ((rands (mapcar #'macroexpand-all (cdr inline--form)))
(expander-app-form `(,,fxn ,@rands)))
(if (seq-every-p #'inline--testconst-exp-p rands)
(let ((r
;; (eval expander-app-form)))
(apply fxn rands)))
(unless (macroexp-const-p r)
(setq r `(quote ,r)))
r)
expander-app-form)))))))
;; (define-inline-pure-subr + (&rest args))
;; (macroexpand '(+ 5 7))
;; (macroexpand-all '(+ 5 7))
(defvar inlined-primitives
(let (purefuncs)
(mapatoms (lambda (x)
(and (fboundp x) (get x 'pure)
(push `(,x . ,x) purefuncs))))
;; these are not truly pure
;; make inline-* variants available for explicit use
(push '(format . inline-format) purefuncs)
(push '(intern . inline-intern) purefuncs)
(setq purefuncs (nreverse purefuncs))
(mapcar (lambda (x)
`(,(car x) ,(cdr x) . ,(inline-extract-arglist (car x))))
purefuncs))
"Association list of pure functions and their argument lists for inlining.")
(mapc (lambda (pr)
(eval `(define-inline-pure-subr ,(car pr) ,(cddr pr) ,(cadr pr))))
inlined-primitives)
(defmacro define-inline-pure (name args &rest body)
"Define NAME as inlined pure function with signature ARGS.
BODY will be evaluated during macroexpansion if given constant arguments."
(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))
expanded-ct-body ct-fxn app-form)
(function-put name 'compiler-macro nil) ; see define-inline
(setq app-form (inline-application-form fxn args))
(setq expanded-ct-body
`(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))))
;; construct a function that should not have
;; circular dependency on the function symbol
;; being inlined
(setq ct-fxn
(let ((x (cl-gensym "x-"))
(expanded-body
`(catch 'inline--just-use
,expanded-ct-body)))
(byte-compile
`(lambda (,args)
(cl-labels ((,name ,args ,@expanded-ct-body))
,app-form)))))
`(progn
(defun ,name ,args
,@doc
(declare (compiler-macro ,cm-name) ,@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)))
(eval-and-compile
(defun ,cm-name ,(cons 'inline--form args)
(let* ((rands (mapcar #'macroexpand-all (cdr inline--form)))
(expander-app-form `(,,fxn ,@rands)))
(if (seq-every-p #'inline--testconst-exp-p rands)
(let ((r
;; (eval expander-app-form)))
(apply ct-fxn rands)))
(unless (macroexp-const-p r)
(setq r `(quote ,r)))
r)
,@expanded-ct-body)))))))
next reply other threads:[~2023-05-13 1:02 UTC|newest]
Thread overview: 2+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-05-13 1:02 Lynn Winebarger [this message]
2023-05-16 0:02 ` define-inline-pure Lynn Winebarger
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='CAM=F=bC9frotw5k3gHAbyk+U9WTkPwMDYSceiQ=PEgq8MOuwPA@mail.gmail.com' \
--to=owinebar@gmail.com \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).