mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

Fix symbols with position appearing in the output of `compile-defun'

Browse source 
This happened with the tags of a condition-case.  Also fix the detection of
circular lists while stripping the positions from symbols with position.

* lisp/emacs-lisp/byte-run.el (byte-run--circular-list-p): Remove.
(byte-run--strip-s-p-1): Write a value of t into a hash table for each cons or
vector/record encountered.  (This is to prevent loops with circular
structures.)  This is now done for all arguments, not just those detected as
circular lists.

* lisp/emacs-lisp/bytecomp.el (byte-compile-file-form-defvar)
(byte-compile-form, byte-compile-dynamic-variable-op)
(byte-compile-constant, byte-compile-push-constant): Remove redundant calls to
`bare-symbol'.
(byte-compile-lambda): call `byte-run-strip-symbol-positions' on the arglist.
(byte-compile-out): call `byte-run-strip-symbol-positions' on the operand.
This is the main call to this function in bytecomp.el.

* src/fns.c (hashfn_eq): Strip the position from an argument which is a symbol
with position.
(hash_lookup): No longer strip a position from a symbol with position.
(sxhash_obj): Add handling for symbols with position, substituting their bare
symbols when symbols with position are enabled.
This commit is contained in:
Alan Mackenzie 2022-02-19 10:38:19 +00:00
parent 767619595c
commit f687e62ac5
3 changed files with 40 additions and 71 deletions
Download patch file Download diff file Expand all files Collapse all files

77
lisp/emacs-lisp/byte-run.el
View file

@ -37,24 +37,6 @@ 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.
@ -64,41 +46,36 @@ Return the modified 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))))
(let* ((hash (gethash arg byte-run--ssp-seen)))
(if hash ; Already processed this node.
arg
(let ((a arg) new)
(while
(progn
(puthash a t byte-run--ssp-seen)
(setq new (byte-run--strip-s-p-1 (car a)))
(setcar a new)
(and (consp (cdr a))
(not
(setq hash (gethash (cdr a) byte-run--ssp-seen)))))
(setq a (cdr a)))
(setq new (byte-run--strip-s-p-1 (cdr a)))
(setcdr a 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))))
(if hash
arg
(let* ((len (length arg))
(i 0)
new)
(puthash arg t byte-run--ssp-seen)
(while (< i len)
(setq new (byte-run--strip-s-p-1 (aref arg i)))
(aset arg i new)
(setq i (1+ i)))
arg))))
(t arg))))