From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Alan Mackenzie Newsgroups: gmane.emacs.devel Subject: New function safe-copy-tree. Date: Mon, 6 Mar 2023 21:14:13 +0000 Message-ID: Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="28477"; mail-complaints-to="usenet@ciao.gmane.io" To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Mon Mar 06 22:14:55 2023 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1pZIAX-0007Cy-Al for ged-emacs-devel@m.gmane-mx.org; Mon, 06 Mar 2023 22:14:53 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pZIAA-0007Pu-Oe; Mon, 06 Mar 2023 16:14:30 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pZIA9-0007PX-9p for emacs-devel@gnu.org; Mon, 06 Mar 2023 16:14:29 -0500 Original-Received: from mx3.muc.de ([193.149.48.5]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pZIA7-0005Gb-21 for emacs-devel@gnu.org; Mon, 06 Mar 2023 16:14:28 -0500 Original-Received: (qmail 53599 invoked by uid 3782); 6 Mar 2023 22:14:13 +0100 Original-Received: from acm.muc.de (pd953adf5.dip0.t-ipconnect.de [217.83.173.245]) (using STARTTLS) by colin.muc.de (tmda-ofmipd) with ESMTP; Mon, 06 Mar 2023 22:14:13 +0100 Original-Received: (qmail 23621 invoked by uid 1000); 6 Mar 2023 21:14:13 -0000 Content-Disposition: inline X-Submission-Agent: TMDA/1.3.x (Ph3nix) X-Primary-Address: acm@muc.de Received-SPF: pass client-ip=193.149.48.5; envelope-from=acm@muc.de; helo=mx3.muc.de X-Spam_score_int: -18 X-Spam_score: -1.9 X-Spam_bar: - X-Spam_report: (-1.9 / 5.0 requ) BAYES_00=-1.9, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.devel:304064 Archived-At: 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)) + ;;;; Various list-search functions. Comments and criticism would be welcome. -- Alan Mackenzie (Nuremberg, Germany).