unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* New function safe-copy-tree.
@ 2023-03-06 21:14 Alan Mackenzie
  2023-03-07 12:12 ` Eli Zaretskii
  2023-03-07 13:37 ` Mattias Engdegård
  0 siblings, 2 replies; 4+ messages in thread
From: Alan Mackenzie @ 2023-03-06 21:14 UTC (permalink / raw)
  To: emacs-devel

Hello, Emacs.

In order to fix bug #61962, I'm intending to introduce a new function
safe-copy-tree in subr.el.  It is like copy-tree, except it works with
circular lists as well as normal ones.

My current implementation looks like this:



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 @@ copy-tree
 	    (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))
+
 \f
 ;;;; Various list-search functions.
 

Comments and criticism would be welcome.

-- 
Alan Mackenzie (Nuremberg, Germany).



^ permalink raw reply related	[flat|nested] 4+ messages in thread
end of thread, other threads:[~2023-03-07 15:52 UTC | newest]

Thread overview: 4+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2023-03-06 21:14 New function safe-copy-tree Alan Mackenzie
2023-03-07 12:12 ` Eli Zaretskii
2023-03-07 13:37 ` Mattias Engdegård
2023-03-07 15:52   ` Alan Mackenzie

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).