1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00

Commit fixes and enhancements to the scratch/correct-warning-pos branch

No longer strip positions from symbols before each use of a form, instead
relying on the low level C routines to do the right thing.  Instead strip them
from miscellaneous places where this is needed.  Stip them alson in
`function-put'.

Push forms onto byte-compile-form-stack and pop them "by hand" rather than by
binding the variable at each pushing, so that it will still have its data
after an error has been thrown and caught by a condition case.  This gives an
source position to the ensuing error message.

* lisp/emacs-lisp/byte-run.el (byte-run--ssp-seen, byte-run--circular-list-p)
(byte-run--strip-s-p-1, byte-run-strip-symbol-positions): New functions and
variables, which together implement stripping of symbol positions.  The latest
(?final) version modifies the argument in place rather than making a copy.
(function-put): Strip symbol positions from all of the arguments before doing
the `put'.

* lisp/emacs-lisp/bytecomp.el (byte-compile--form-stack): has been renamed to
byte-compile-form-stack and moved to macroexp.el.
(byte-compile-initial-macro-environment (eval-and-compile)): Replace
macroexpand-all-toplevel with macroexpand--all-toplevel.
(displaying-byte-compile-warnings): bind byte-compile-form-stack here.
(byte-compile-toplevel-file-form, byte-compile-form): Push the top level form
onto byte-compile-form-stack (whereas formally the variable was bound at each
pushing).  Manually pop this from of the variable at the end of the function.

* lisp/emacs-lisp/cl-macs.el (cl-define-compiler-macro): Remove the symbol
stripping.

* lisp/emacs-lisp/comp.el (comp--native-compile): Set max-specpdl-size to at
least 5000 (previously it was 2500).  Bind print-symbols-bare to t.

* lisp/emacs-lisp/macroexp.el (byte-compile-form-stack): Definition move here
from bytecomp.el for easier compilation.
(byte-compile-strip-symbol-positions and associated functions): Removed.
(macro--expand-all): push argument FORM onto byte-compile-form-stack at the
start of this function, and pop it off at the end.
(internal-macroexpand-for-load): No longer strip symbol positions.  Bind
symbols-with-pos-enabled and print-symbols-bare to t.

* lisp/help.el (help--make-usage): Strip any position from argument ARG.

* src/fns.c (Fput): No longer strip symbol positions from any of the
arguments.
This commit is contained in:
Alan Mackenzie 2022-01-14 19:06:04 +00:00
parent 2128cd8c08
commit 57b698f159
7 changed files with 296 additions and 295 deletions

View file

@ -30,6 +30,83 @@
;;; Code:
(defvar byte-run--ssp-seen nil
"Which conses/vectors/records have been processed in strip-symbol-positions?
The value is a hash table, the key being the old element and the value being
the corresponding new element of the same type.
The purpose of this is to detect circular structures.")
(defalias 'byte-run--circular-list-p
#'(lambda (l)
"Return non-nil when the list L is a circular list.
Note that this algorithm doesn't check any circularity in the
CARs of list elements."
(let ((hare l)
(tortoise l))
(condition-case err
(progn
(while (progn
(setq hare (cdr (cdr hare))
tortoise (cdr tortoise))
(not (or (eq tortoise hare)
(null hare)))))
(eq tortoise hare))
(wrong-type-argument nil)
(error (signal (car err) (cdr err)))))))
(defalias 'byte-run--strip-s-p-1
#'(lambda (arg)
"Strip all positions from symbols in ARG, modifying ARG.
Return the modified ARG."
(cond
((symbol-with-pos-p arg)
(bare-symbol arg))
((consp arg)
(let* ((round (byte-run--circular-list-p arg))
(hash (and round (gethash arg byte-run--ssp-seen))))
(or hash
(let ((a arg) new)
(while
(progn
(when round
(puthash a new byte-run--ssp-seen))
(setq new (byte-run--strip-s-p-1 (car a)))
(when (not (eq new (car a))) ; For read-only things.
(setcar a new))
(and (consp (cdr a))
(not
(setq hash
(and round
(gethash (cdr a) byte-run--ssp-seen))))))
(setq a (cdr a)))
(setq new (byte-run--strip-s-p-1 (cdr a)))
(when (not (eq new (cdr a)))
(setcdr a (or hash new)))
arg))))
((or (vectorp arg) (recordp arg))
(let ((hash (gethash arg byte-run--ssp-seen)))
(or hash
(let* ((len (length arg))
(i 0)
new)
(puthash arg arg byte-run--ssp-seen)
(while (< i len)
(setq new (byte-run--strip-s-p-1 (aref arg i)))
(when (not (eq new (aref arg i)))
(aset arg i new))
(setq i (1+ i)))
arg))))
(t arg))))
(defalias 'byte-run-strip-symbol-positions
#'(lambda (arg)
(setq byte-run--ssp-seen (make-hash-table :test 'eq))
(byte-run--strip-s-p-1 arg)))
(defalias 'function-put
;; We don't want people to just use `put' because we can't conveniently
;; hook into `put' to remap old properties to new ones. But for now, there's
@ -38,7 +115,9 @@
"Set FUNCTION's property PROP to VALUE.
The namespace for PROP is shared with symbols.
So far, FUNCTION can only be a symbol, not a lambda expression."
(put function prop value)))
(put (bare-symbol function)
(byte-run-strip-symbol-positions prop)
(byte-run-strip-symbol-positions value))))
(function-put 'defmacro 'doc-string-elt 3)
(function-put 'defmacro 'lisp-indent-function 2)