diff options
author | Alan Mackenzie <acm@muc.de> | 2021-12-30 10:14:58 +0000 |
---|---|---|
committer | Alan Mackenzie <acm@muc.de> | 2021-12-30 10:14:58 +0000 |
commit | 1cd188799f86bcb13ad76e82e3436b1b7e9f9e9f (patch) | |
tree | 24816cf792eeffd87994d0dd27cf269c44c6688c /lisp/emacs-lisp/macroexp.el | |
parent | 8f1106ddf2a3861e9c1ebb9d8fa3d4087899de81 (diff) | |
download | emacs-1cd188799f86bcb13ad76e82e3436b1b7e9f9e9f.tar.gz emacs-1cd188799f86bcb13ad76e82e3436b1b7e9f9e9f.tar.bz2 emacs-1cd188799f86bcb13ad76e82e3436b1b7e9f9e9f.zip |
Make symbols with positions work with native compilation
This version of the software should bootstrap Emacs successfully with native
compilation enabled.
* lisp/emacs-lisp/bytecomp.el (byte-compile-strip-s-p-1)
(byte-compile-strip-symbol-positions): Rename and move to macroexp.el. Rename
calls to these functions throughout the file.
(byte-compile-initial-macro-environment): In the code sections for
eval-when-compile and eval-and-compile, call macroexp-strip-symbol-positions
before evaluating code.
(byte-compile-file, byte-compile-output-file-form)
(byte-compile-file-form-defmumble, byte-compile, batch-byte-compile): Call
macroexp-strip-symbol-positions from code being passed to the native compiler.
* lisp/emacs-lisp/cl-macs.el (cl-macs--strip-s-p-1)
(cl-macs--strip-symbol-positions): Remove, replacing them with the renamed
functions in macroexp.el.
(cl-define-compiler-macro): Apply macroexp-strip-symbol-positions to ARGS and
BODY.
* lisp/emacs-lisp/comp.el (comp-limplify-lap-inst): Use `null' to compile
byte-not rather than a compilation of `eq'.
(comp--native-compile): bind symbols-with-pos-enabled to t.
* lisp/emacs-lisp/macroexp.el (byte-compile--ssp-conses-seen)
(byte-compile--ssp-vectors-seen, byte-compile--ssp-records-seen): Provisional
auxiliary variables to support the following functions.
(macroexp--strip-s-p-2, byte-compile-strip-s-p-1)
(macroexp-strip-symbol-positions): Functions moved from bytecomp.el, renamed,
and further developed.
(macroexp--compiler-macro): Bind symbol-with-pos-enabled to t around the call
to `handler'.
(internal-macroexpand-for-load): Strip symbol positions from the form being
eagerly expanded for macros.
* src/comp.c (F_SYMBOLS_WITH_POS_ENABLED_RELOC_SYM): New macro for a
relocation symbol.
(comp_t): New elements bool_ptr_type, f_symbols_with_pos_enabled_ref,
lisp_symbol_with_position, lisp_symbol_with_position_header,
lisp_symbol_with_position_sym, lisp_symbol_with_position_pos,
lisp_symbol_with_position_type, lisp_symbol_with_position_ptr_type,
get_symbol_with_position.
(helper_GET_SYMBOL_WITH_POSITION): New function.
(emit_BASE_EQ): Function rename from emit_EQ.
(emit_AND, emit_OR, emit_BARE_SYMBOL_P, emit_SYMBOL_WITH_POS_P)
(emit_SYMBOL_WITH_POS_SYM): New functions.
(emit_EQ): New function which handles symbols with position correctly.
(emit_NILP): Use emit_BASE_EQ rather than emit_EQ.
(emit_limple_insn): When emitting a conditional branch, check each operand for
being a literal Qnil, and if one of them is, use emit_BASE_EQ rather than
emit_EQ.
(declare_runtime_imported_funcs): Declare helper_GET_SYMBOL_WITH_POSITION.
(emit_ctxt_code): Export the global F_SYMBOLS_WITH_POS_ENABLED_RELOC_SYM.
(define_lisp_symbol_with_position, define_GET_SYMBOL_WITH_POSITION): New
functions.
(Fcomp__init_ctxt): Initialise comp.bool_ptr_type, call the two new
define_.... functions.
(load_comp_unit): Initialise **f_symbols_with_pos_enabled_reloc.
* src/fns.c (Fput): Strip positions from symbols in PROPNAME and VALUE.
Diffstat (limited to 'lisp/emacs-lisp/macroexp.el')
-rw-r--r-- | lisp/emacs-lisp/macroexp.el | 66 |
1 files changed, 63 insertions, 3 deletions
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 60fac981308..dafd5497639 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -32,6 +32,64 @@ ;; macros defined by `defmacro'. (defvar macroexpand-all-environment nil) +(defvar byte-compile--ssp-conses-seen nil + "Which conses have been processed in a strip-symbol-positions operation?") +(defvar byte-compile--ssp-vectors-seen nil + "Which vectors have been processed in a strip-symbol-positions operation?") +(defvar byte-compile--ssp-records-seen nil + "Which records have been processed in a strip-symbol-positions operation?") + +(defun macroexp--strip-s-p-2 (arg) + "Strip all positions from symbols in ARG, destructively modifying ARG. +Return the modified ARG." + (cond + ((symbolp arg) + (bare-symbol arg)) + ((consp arg) + (unless (memq arg byte-compile--ssp-conses-seen) + ;; (push arg byte-compile--ssp-conses-seen) + (let ((a arg)) + (while (consp (cdr a)) + (setcar a (macroexp--strip-s-p-2 (car a))) + (setq a (cdr a))) + (setcar a (macroexp--strip-s-p-2 (car a))) + ;; (if (cdr a) + (unless (bare-symbol-p (cdr a)) ; includes (unpositioned) nil. + (setcdr a (macroexp--strip-s-p-2 (cdr a)))))) + arg) + ((vectorp arg) + (unless (memq arg byte-compile--ssp-vectors-seen) + (push arg byte-compile--ssp-vectors-seen) + (let ((i 0) + (len (length arg))) + (while (< i len) + (aset arg i (macroexp--strip-s-p-2 (aref arg i))) + (setq i (1+ i))))) + arg) + ((recordp arg) + (unless (memq arg byte-compile--ssp-records-seen) + (push arg byte-compile--ssp-records-seen) + (let ((i 0) + (len (length arg))) + (while (< i len) + (aset arg i (macroexp--strip-s-p-2 (aref arg i))) + (setq i (1+ i))))) + arg) + (t arg))) + +(defun byte-compile-strip-s-p-1 (arg) + "Strip all positions from symbols in ARG, destructively modifying ARG. +Return the modified ARG." + (setq byte-compile--ssp-conses-seen nil) + (setq byte-compile--ssp-vectors-seen nil) + (setq byte-compile--ssp-records-seen nil) + (macroexp--strip-s-p-2 arg)) + +(defun macroexp-strip-symbol-positions (arg) + "Strip all positions from symbols (recursively) in ARG. Don't modify ARG." + (let ((arg1 (copy-tree arg t))) + (byte-compile-strip-s-p-1 arg1))) + (defun macroexp--cons (car cdr original-cons) "Return ORIGINAL-CONS if the car/cdr of it is `eq' to CAR and CDR, respectively. If not, return (CAR . CDR)." @@ -96,10 +154,11 @@ each clause." (defun macroexp--compiler-macro (handler form) (condition-case-unless-debug err - (apply handler form (cdr form)) + (let ((symbols-with-pos-enabled t)) + (apply handler form (cdr form))) (error - (message "Compiler-macro error for %S: %S" (car form) err) - form))) + (message "Compiler-macro error for %S: Handler: %S\n%S" (car form) handler err) + form))) (defun macroexp--funcall-if-compiled (_form) "Pseudo function used internally by macroexp to delay warnings. @@ -683,6 +742,7 @@ test of free variables in the following ways: (defun internal-macroexpand-for-load (form full-p) ;; Called from the eager-macroexpansion in readevalloop. + (setq form (macroexp-strip-symbol-positions form)) (cond ;; Don't repeat the same warning for every top-level element. ((eq 'skip (car macroexp--pending-eager-loads)) form) |