diff options
author | Alan Mackenzie <acm@muc.de> | 2023-03-07 08:00:25 +0000 |
---|---|---|
committer | Alan Mackenzie <acm@muc.de> | 2023-03-07 08:00:25 +0000 |
commit | fa83b236111ea024b75a8bb33b78a99f437a9a67 (patch) | |
tree | d288fbdbdfb57f173ffb06c6b832c3ce7b201a4d /lisp/subr.el | |
parent | 8179555730d23f43b3043df0bfecc9f9c4f36eda (diff) | |
download | emacs-fa83b236111ea024b75a8bb33b78a99f437a9a67.tar.gz |
eval-and-compile: Strip symbol positions for eval but not for compile.
This fixes bug #61962.
* lisp/subr.el (safe-copy-tree): New function.
* lisp/emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): Amend
the entry for eval-and-compile to use safe-copy-tree and
byte-run-strip-symbol-positions for the eval part.
* doc/lispref/lists.texi (Building Lists): Document safe-copy-tree.
* etc/NEWS: Note the new function safe-copy-tree.
Diffstat (limited to 'lisp/subr.el')
-rw-r--r-- | lisp/subr.el | 53 |
1 files changed, 53 insertions, 0 deletions
diff --git a/lisp/subr.el b/lisp/subr.el index 8ff3b868fab..2066be581d1 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -845,6 +845,59 @@ argument VECP, this copies vectors as well as conses." (aset tree i (copy-tree (aref tree i) vecp))) tree) tree))) + +(defvar safe-copy-tree--seen nil + "A hash table for conses/vectors/records already seen by safe-copy-tree-1. +It's key is a cons or vector/record seen by the algorithm, and its value is +the corresponding cons/vector/record in the copy.") + +(defun safe-copy-tree--1 (tree &optional vecp) + "Make a copy of TREE, taking circular structure into account. +If TREE is a cons cell, this recursively copies both its car and its cdr. +Contrast to `copy-sequence', which copies only along the cdrs. With second +argument VECP, this copies vectors and records as well as conses." + (cond + ((gethash tree safe-copy-tree--seen)) + ((consp tree) + (let* ((result (cons (car tree) (cdr tree))) + (newcons result) + hash) + (while (and (not hash) (consp tree)) + (if (setq hash (gethash tree safe-copy-tree--seen)) + (setq newcons hash) + (puthash tree newcons safe-copy-tree--seen)) + (setq tree newcons) + (unless hash + (if (or (consp (car tree)) + (and vecp (or (vectorp (car tree)) (recordp (car tree))))) + (let ((newcar (safe-copy-tree--1 (car tree) vecp))) + (setcar tree newcar))) + (setq newcons (if (consp (cdr tree)) + (cons (cadr tree) (cddr tree)) + (cdr tree))) + (setcdr tree newcons) + (setq tree (cdr tree)))) + (nconc result + (if (and vecp (or (vectorp tree) (recordp tree))) + (safe-copy-tree--1 tree vecp) tree)))) + ((and vecp (or (vectorp tree) (recordp tree))) + (let* ((newvec (copy-sequence tree)) + (i (length newvec))) + (puthash tree newvec safe-copy-tree--seen) + (setq tree newvec) + (while (>= (setq i (1- i)) 0) + (aset tree i (safe-copy-tree--1 (aref tree i) vecp))) + tree)) + (t tree))) + +(defun safe-copy-tree (tree &optional vecp) + "Make a copy of TREE, taking circular structure into account. +If TREE is a cons cell, this recursively copies both its car and its cdr. +Contrast to `copy-sequence', which copies only along the cdrs. With second +argument VECP, this copies vectors and records as well as conses." + (setq safe-copy-tree--seen (make-hash-table :test #'eq)) + (safe-copy-tree--1 tree vecp)) + ;;;; Various list-search functions. |