From 3e8759320ecba4156cd3315ef02ea902ff408ae3 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 14 Jul 2017 00:32:34 -0400 Subject: [PATCH v2 1/2] Let `define-symbol-prop' take effect during compilation * src/fns.c (syms_of_fns): New variable `overriding-plist-environment'. (Fget): Consult it. * lisp/emacs-lisp/bytecomp.el (byte-compile-close-variables): Let-bind it to nil. (byte-compile-define-symbol-prop): New function, handles compilation of top-level `define-symbol-prop' and `function-put' calls by putting the symbol setting into `overriding-plist-environment'. Co-authored-by: Noam Postavsky --- lisp/emacs-lisp/bytecomp.el | 29 +++++++++++++++++++++++++++++ src/fns.c | 11 +++++++++++ test/lisp/emacs-lisp/bytecomp-tests.el | 17 +++++++++++++++++ 3 files changed, 57 insertions(+) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index fdd4276e4e..a1626c0b9d 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1572,6 +1572,7 @@ (defmacro byte-compile-close-variables (&rest body) ;; macroenvironment. (copy-alist byte-compile-initial-macro-environment)) (byte-compile--outbuffer nil) + (overriding-plist-environment nil) (byte-compile-function-environment nil) (byte-compile-bound-variables nil) (byte-compile-lexical-variables nil) @@ -4712,6 +4713,34 @@ (put 'make-variable-buffer-local 'byte-hunk-handler 'byte-compile-form-make-variable-buffer-local) (defun byte-compile-form-make-variable-buffer-local (form) (byte-compile-keep-pending form 'byte-compile-normal-call)) + +(put 'function-put 'byte-hunk-handler 'byte-compile-define-symbol-prop) +(put 'define-symbol-prop 'byte-hunk-handler 'byte-compile-define-symbol-prop) +(defun byte-compile-define-symbol-prop (form) + (pcase form + ((and `(,op ,fun ,prop ,val) + (guard (and (macroexp-const-p fun) + (macroexp-const-p prop) + (or (macroexp-const-p val) + ;; Also accept anonymous functions, since + ;; we're at top-level which implies they're + ;; also constants. + (pcase val (`(function (lambda . ,_)) t)))))) + (byte-compile-push-constant op) + (byte-compile-form fun) + (byte-compile-form prop) + (let* ((fun (eval fun)) + (prop (eval prop)) + (val (if (macroexp-const-p val) + (eval val) + (byte-compile-lambda (cadr val))))) + (push `(,fun + . (,prop ,val ,@(alist-get fun overriding-plist-environment))) + overriding-plist-environment) + (byte-compile-push-constant val) + (byte-compile-out 'byte-call 3))) + + (_ (byte-compile-keep-pending form)))) ;;; tags diff --git a/src/fns.c b/src/fns.c index d849618f2b..00b6ed6a28 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1987,6 +1987,10 @@ DEFUN ("get", Fget, Sget, 2, 2, 0, (Lisp_Object symbol, Lisp_Object propname) { CHECK_SYMBOL (symbol); + Lisp_Object propval = Fplist_get (CDR (Fassq (symbol, Voverriding_plist_environment)), + propname); + if (!NILP (propval)) + return propval; return Fplist_get (XSYMBOL (symbol)->plist, propname); } @@ -5163,6 +5167,13 @@ syms_of_fns (void) DEFSYM (Qcursor_in_echo_area, "cursor-in-echo-area"); DEFSYM (Qwidget_type, "widget-type"); + DEFVAR_LISP ("overriding-plist-environment", Voverriding_plist_environment, + doc: /* An alist overrides the plists of the symbols which it lists. +Used by the byte-compiler to apply `define-symbol-prop' during +compilation. */); + Voverriding_plist_environment = Qnil; + DEFSYM (Qoverriding_plist_environment, "overriding-plist-environment"); + staticpro (&string_char_byte_cache_string); string_char_byte_cache_string = Qnil; diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index d15bd8b6e6..8ef2ce7025 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -545,6 +545,23 @@ (ert-deftest bytecomp-tests--old-style-backquotes () This functionality has been obsolete for more than 10 years already and will be removed soon. See (elisp)Backquote in the manual."))))))) + +(ert-deftest bytecomp-tests-function-put () + "Check `function-put' operates during compilation." + (should (boundp 'lread--old-style-backquotes)) + (bytecomp-tests--with-temp-file source + (dolist (form '((function-put 'bytecomp-tests--foo 'foo 1) + (function-put 'bytecomp-tests--foo 'bar 2) + (defmacro bytecomp-tests--foobar () + `(cons ,(function-get 'bytecomp-tests--foo 'foo) + ,(function-get 'bytecomp-tests--foo 'bar))) + (defvar bytecomp-tests--foobar 1) + (setq bytecomp-tests--foobar (bytecomp-tests--foobar)))) + (print form (current-buffer))) + (write-region (point-min) (point-max) source nil 'silent) + (byte-compile-file source t) + (should (equal bytecomp-tests--foobar (cons 1 2))))) + ;; Local Variables: ;; no-byte-compile: t ;; End: -- 2.11.1