From 0da95fb682a5dba762ad7d0a98bb1d111ec1f2f5 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Gerd=20M=C3=B6llmann?= Date: Sat, 22 Jul 2023 14:17:06 +0200 Subject: [PATCH] Compiler macros for intern and intern-soft * lisp/emacs-lisp/bytecomp.el (byte-code-expand-for-package-prefixes): Pass last argument depending on buffer-local value of package-prefixes while byte compiling. (intern, intern-soft): New compiler macros. * src/pkg.c (init_pkg_once): New keyword symbols. --- lisp/emacs-lisp/bytecomp.el | 14 ++++++++++++++ src/pkg.c | 9 ++++++++- 2 files changed, 22 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e65e7a313b6..6dd97be3c84 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -131,6 +131,20 @@ (eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'subr-x)) +(defun byte-code-expand-for-package-prefixes (form) + (let ((cl (if package-prefixes :set-by-compiler :unset-by-compiler))) + (pcase form + (`(,_ ,_ ,_ ,_) form) + (`(,_ ,_ ,_) (append form (list cl))) + (`(,_ ,_) (append form (list nil cl))) + (_ form)))) + +(cl-define-compiler-macro intern (&whole form _name &optional _package _cl) + (byte-code-expand-for-package-prefixes form)) + +(cl-define-compiler-macro intern-soft (&whole form _name &optional _package _cl) + (byte-code-expand-for-package-prefixes form)) + ;; The feature of compiling in a specific target Emacs version ;; has been turned off because compile time options are a bad idea. (defgroup bytecomp nil diff --git a/src/pkg.c b/src/pkg.c index 52d05a69e26..e2fc8c5e8f7 100644 --- a/src/pkg.c +++ b/src/pkg.c @@ -518,7 +518,12 @@ pkg_fake_me_an_obarray (Lisp_Object vector) return package; } -/* Implements Emacs' traditional Fintern function. */ +/* Implements Emacs' traditional Fintern function. + + CL can be one of + + :set-by-compiler - intern seen by compiler with package-prefixes nil. + :set-by-compiler - intern seen by compiler with package-prefixes non-nil. */ Lisp_Object pkg_emacs_intern (Lisp_Object name, Lisp_Object package, Lisp_Object cl) @@ -918,6 +923,8 @@ DEFUN ("watch-*package*", Fwatch_earmuffs_package, Swatch_earmuffs_package, void init_pkg_once (void) { + DEFSYM (QCset_by_compiler, ":set-by-compiler"); + DEFSYM (QCunset_by_compiler, ":unset-by-compiler"); DEFSYM (QCexternal, ":external"); DEFSYM (QCinherited, ":inherited"); DEFSYM (QCinternal, ":internal"); -- 2.39.2