The form (cl-copy-tree TREE t) returns a deep-copy of a sequence TREE.
The the Common Lisp Hyper Spec explains that copy-tree does not preserve circularities and sharing of substructures. I.e., even if copy-tree delivers a deep copy it is not structure-preserving.
Is there a structure-preserving version of tree-copy in the elisp library shipped with emacs or even built-in?
The following example demonstrates the structural difference between the argument and the result of copy-tree.
(let* (ret
(print-circle t)
(l '((1 2) (3)))
(c (progn
(setcdr (nth 1 l) (car l))
(cl-copy-tree l))))
(setq ret (format "l: %S\nc: %S\n" l c))
(setcar (car l) 4)
(setcar (car c) 4)
(setq print-circle nil)
(concat ret (format "Effect of the structural difference:\nl: %S\nc: %S\n" l c))
)
Evaluation of this form delivers:
l: (#1=(1 2) (3 . #1#))
c: ((1 2) (3 1 2))
Effect of the structural difference:
l: ((4 2) (3 4 2))
c: ((4 2) (3 1 2))
The following code shows that a library implementation of a structure-preserving version of copy-tree would be possible. I needed it already for an answer related to undo-tree.
(cl-defstruct (copy-tree*
(:constructor copy-tree*-mem (&optional stack stack-new (hash (make-hash-table)))))
stack stack-new hash)
(defmacro copy-tree*--push (el el-new mem &optional hash)
"Put EL onto the stack and EL-NEW onto stack-new in the `copy-tree*'
structure MEM. Add a key-value pair mapping EL to EL-NEW in the hash map
of mem."
(let ((my-el (make-symbol "my-el"))
(my-el-new (make-symbol "my-el-new"))) ; makes sure `el' is only evaluated once
(append `(let ((,my-el ,el)
(,my-el-new ,el-new))
(push ,my-el (copy-tree*-stack ,mem))
(push ,my-el-new (copy-tree*-stack-new ,mem)))
(and hash
`((puthash ,my-el ,my-el-new (copy-tree*-hash ,mem))))
(list my-el-new))))
(defmacro copy-tree*--pop (el el-new mem)
`(setq ,el (pop (copy-tree*-stack ,mem))
,el-new (pop (copy-tree*-stack-new mem))))
(defun copy-tree*--copy-node (node mem vecp)
"If NODE is not a `cons' just return it.
Create a new copy of NODE if NODE is a `cons' not already contained in the hash map of mem (a `copy-tree*' structure). Register NODE and its copy as key-value pair in the hash table.
If NODE is already a key of the hash map return its copy.
With non-nil VECP vectors are treated analogously to conses."
(if (or (consp node)
(and vecp (vectorp node)))
(let ((existing-node (gethash node (copy-tree*-hash mem))))
(if existing-node
existing-node
(copy-tree*--push node (if (consp node)
(cons nil nil)
(make-vector (length node) nil))
mem t)))
node))
(defun copy-tree* (tree &optional vecp)
"Structure preserving version of `cl-copy-tree'."
(if (or (consp tree)
(and vecp (vectorp tree)))
(let* ((tree-new (if (consp tree) (cons nil nil)
(make-vector (length tree) nil)))
(mem (copy-tree*-mem))
next
next-new)
(copy-tree*--push tree tree-new mem t)
(while (copy-tree*--pop next next-new mem)
(cond
((consp next)
(setcar next-new (copy-tree*--copy-node (car next) mem vecp))
(setcdr next-new (copy-tree*--copy-node (cdr next) mem vecp)))
((and vecp (vectorp next))
(cl-loop for i from 0 below (length next) do
(aset next-new i (copy-tree*--copy-node (aref next i) mem vecp))))))
tree-new)
tree))
The following example is a modified version of the first example.
The only modification is that cl-copy-tree is replaced by copy-tree*.
(let* (ret
(print-circle t)
(l '((1 2) (3)))
(c (progn
(setcdr (nth 1 l) (car l))
(copy-tree* l))))
(setq ret (format "l: %S\nc: %S\n" l c))
(setcar (car l) 4)
(setcar (car c) 4)
(setq print-circle nil)
(concat ret (format "Effect of the structural difference:\nl: %S\nc: %S\n" l c))
)
The output of this form demonstrates that copy-tree* produces a structure-preserving copy of its argument.
l: (#1=(1 2) (3 . #1#))
c: (#1=(1 2) (3 . #1#))
Effect of the structural difference:
l: ((4 2) (3 4 2))
c: ((4 2) (3 4 2))
