summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp/macroexp.el
diff options
context:
space:
mode:
authorAlan Mackenzie <acm@muc.de>2021-12-30 10:14:58 +0000
committerAlan Mackenzie <acm@muc.de>2021-12-30 10:14:58 +0000
commit1cd188799f86bcb13ad76e82e3436b1b7e9f9e9f (patch)
tree24816cf792eeffd87994d0dd27cf269c44c6688c /lisp/emacs-lisp/macroexp.el
parent8f1106ddf2a3861e9c1ebb9d8fa3d4087899de81 (diff)
downloademacs-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.el66
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)