Following up Basils comment on the problems with recursive solutions I give here an iterative solution.
It exploits a breadth first search and therefore needs a queue. My first attempt with a depths-first search caused me some trouble with creating the structure and setting the values of the return tree.
The queue impl comes with the answer but you can also use other libraries like elib for that purpose.
The tree
argument of map-tree-iter
must be a list. Atoms and dotted lists are not allowed.
Note that I did not care about execution speed for this proof of concept implementation.
(defun make-queue (&rest elements)
"Return queue structure.
A queue is a cons.
Its `cdr' is the actual data list and its `car' contains the last link
of the data list for fast tail update.
If (cdr QUEUE) is nil so is (car QUEUE)."
(cons (last elements) elements))
(defun queue-push-back (queue &rest new-elements)
"Append NEW-ELEMENT to QUEUE."
(if (car queue)
(setcar queue
(last (setcdr (car queue) new-elements)))
(setcar queue (last (setcdr queue new-elements)))))
(defmacro queue-front (queue)
"Return first element of QUEUE.
The returned value is a place setable with setf."
`(cadr ,queue))
(defmacro queue-pop-front (queue)
"Pop the first element of QUEUE.
The return value is nil if there is no first element."
`(prog1
(pop (cdr ,queue))
(unless (cdr ,queue)
(setcar ,queue nil))))
(define-inline queue-not-empty-p (queue)
"Return non-nil if QUEUE is not empty."
(inline-letevals
(queue)
(inline-quote (car ,queue))))
(define-inline queue-to-list (queue)
"Convert QUEUE to a list.
Note that QUEUE and the returned list
share content and structure.
If you want to modify the structure of the returned list
you should consider (copy-list (queue-to-list QUEUE))."
(inline-letevals (queue)
(inline-quote (cdr ,queue))))
(defun queue-empty-p (queue)
"Return non-nil if QUEUE is empty."
(null (queue-not-empty-p queue)))
(defun map-tree-iter (fun tree)
"Map FUN over TREE."
(let* ((queue (make-queue tree))
(ret (list nil))
(queue-ret (make-queue ret)))
(while (queue-not-empty-p queue)
(let ((front (queue-pop-front queue))
(front-ret (queue-pop-front queue-ret)))
(while front
(cond
((consp (car front))
(queue-push-back queue (car front))
(let ((list-ret (list nil)))
(queue-push-back queue-ret list-ret)
(setcar front-ret list-ret)))
((car front)
(setcar front-ret (funcall fun (car front))))
)
(setq front (cdr front))
(when front
(setcdr front-ret (list nil))
(setq front-ret (cdr front-ret))))))
ret))