GNU bug report logs - #26629
25.1.50; Feature-request: Structure-preserving copying of sequences

Previous Next

Full log

View this message in rfc822 format

From: Tobias Zawada <i <at> tn-home.de>
To: 26629 <at> debbugs.gnu.org
Subject: bug#26629: 25.1.50; Feature-request: Structure-preserving copying of sequences
Date: Mon, 24 Apr 2017 00:02:25 +0200

Dear emacs maintainers,
I propose to implement a structure-preserving version of copy-tree in
emacs. It could be part of one of the elisp libraries (e.g., seq.el or subr.el) or it could be an
internal function. An example implementation is cited at the end of this mail.

The function copy-tree copies recursively but not structure preserving.
If two cars or cdrs link to the same sub-list in the original data
they point to two separate sub-lists in the copy.
As mentioned in the Common Lisp Hyper Spec
(http://clhs.lisp.se/Body/f_cp_tre.htm) this is the intended behavior of copy-tree.

I needed a structure-preserving copy of a graph for the solution of the request
https://emacs.stackexchange.com/questions/32194/undo-tree-history-file-without-text-properties

So I wrote my own version of copy-tree* and asked at
https://emacs.stackexchange.com/questions/32316/structure-preserving-copying-of-sequences
whether anyone knows some built-in version for that purpose.

Drew responded that he does not know about any such function and
recommended to write this feature request.

For making this request self-contained I cite in the following my version of
copy-tree*. Feel free to use it or parts of it for emacs if you
like. There are no license-restrictions on the code.

About the code: Traversing of the original graph and construction of the new graph are
stack-based as it is standard. There is an additional hash-map that maps
the already traversed old nodes to the newly created ones. If some old
node is already in the hash-map we do not create a new one in the copied
graph but use the mapped one from the hash map.
I chose the name `copy-tree*' because of the similarity of the function to `copy-tree'.
Considering the functionality maybe the name `copy-graph' would be more appropriate.

(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))

Best regards,
Tobias Zawada

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.