Recently, the recursive code for the copy-tree function in sbcl was rewritten so as to prevent stackoverflow on long lists.
This prompted me to write an iterative version, one-pass, no stack, no unnecessary consing, version of copy-tree in common-lisp, working with nested, perhaps dotted, lists. The result is given below. The performance is ok. In fact, on sbcl it is faster than the native implementation, and almost as fast as copy-list for proper lists. It also has no problem making copies of "reversed" lists like the one created by (reduce 'cons (make-list 1000000 :initial-element 0)) (sbcl and ccl versions of coy-tree stackoverflow on such lists).
Unfortunately, my code is unreadable, and I must say I can't really understand it now without drawing a whole page of cons cells. Also it is not very flexible, e. g. there is no obvious way to turn it into a reduce-tree, in contrast to the recursive version.
Is there a way to write the code below in a more readable and flexible way, and so to speak in a more lispy way, without losing performance ?
This prompted me to write an iterative version, one-pass, no stack, no unnecessary consing, version of copy-tree in common-lisp, working with nested, perhaps dotted, lists. The result is given below. The performance is ok. In fact, on sbcl it is faster than the native implementation, and almost as fast as copy-list for proper lists. It also has no problem making copies of "reversed" lists like the one created by (reduce 'cons (make-list 1000000 :initial-element 0)) (sbcl and ccl versions of coy-tree stackoverflow on such lists).
Unfortunately, my code is unreadable, and I must say I can't really understand it now without drawing a whole page of cons cells. Also it is not very flexible, e. g. there is no obvious way to turn it into a reduce-tree, in contrast to the recursive version.
Is there a way to write the code below in a more readable and flexible way, and so to speak in a more lispy way, without losing performance ?
(defun my-copy-tree (tree)
(do* ((result (list tree))
(node result)
(next))
((null node) result)
(cond ((and (consp (cdar node))(atom (caar node)))
(setf (cdr node) (cons (cdar node) (cdr node))
(car node) (caar node)
node (cdr node)))
((consp (cdar node))
(setf (cdr node) (cons (cdar node) (cdr node))
(car node) (cons (caar node) (cdr node))
node (car node)))
((consp (caar node))
(setf (car node) (cons (car node) (cdr node))
(cdr node) (cdaar node)
node (car node)
(car node) (caar node)))
(t (setf next (cdr node)
(cdr node) (cdar node)
(car node) (caar node)
node next)))))