;;;; Written & tested in SBCL, will need adjustment for Elisp and (require 'cl);
;;;;  Elisp's FORMAT has different meaning and format strings!

;;;;  My previous version of breadth-first traversal made new cons cells around
;;;;   the original tree's cells, without their cdrs, when adding them to the queue.
;;;;     E.g., for (1 2 3 4), only (2), (3), and (4) went into the queue, instead 
;;;;     of the original tree's cons cell pointers (2 3 4), (3 4), (4). 
;;;;     This made handling the queue easier, but lost me the ability to operate
;;;;     on the tree---I could only collect its leaves.

;;;; Running the queue of only the actual tree's cons cells requires not adding
;;;;  any siblings twice when processing a node if they have been added before.
;;;;  Hence the hash table for keeping track.

;;; This function does a BFS traversal of the tree, changing every node's atom
;;;    into the result of calling func on it.
(defun bfs-modify (l func)
  (let ((q (list l))
        (visited-nodes (make-hash-table)))
    (labels (
             ;; add nodes from lst to queue, destructively
             ;;  only add nodes not in the visited nodes table
             (add-to-queue (queue lst)                       
               (let ((siblings (mapcon #'list lst)))         ; same as (make-lst-of-cdrs lst)))
                 ;; add siblings not yet in the queue to the queue
                 (let ((upd-queue 
                        (nconc queue (remove-if (lambda (s) (gethash s visited-nodes)) siblings))))
                   ;; now add these to the hash
                   (mapcar (lambda (s) (setf (gethash s visited-nodes) t)) siblings)
                   upd-queue))) ; must return the updated value, not result of mapcar
             
             ;; actual traversal
             (bfs-aux (q)           ; queue processor, instead of the loop
               (format t "q: ~S l: ~S ~%" q l)
               (if (not (null q))      ; if no more nodes on the queue, return the result list
                   (let ((n (car q))   ; get next node off the queue 
                         (q (cdr q)))  ;  ..and adjust the queue
                     (if (atom (car n))                        ; if the node is a leaf
                         (progn 
                           (format t "  branch1 cdr_n: ~S~%" (cdr n))
                           (rplaca n (funcall func (car n)))   ;  ...apply func to it and 
                           (bfs-aux (add-to-queue q (cdr n)))) ;  ...add its siblings to queue 
                         ;; otherwise it's not a leaf, add it to queue _after_ siblings
                         (bfs-aux (add-to-queue (add-to-queue q (cdr n)) ; add siblings
                                                (car n))))))))           ; add the non-leaf to the back
      (bfs-aux q)
      l)))

;; testing
(bfs-modify '(1) (lambda (x) 'z))

(bfs-modify nil (lambda (x) 'z))   ; fix this!

(bfs-modify '(1 (2) 3) (lambda (x) 'z))

(bfs-modify '(((((1)) 2)) 4 (((2) (3 5)))) (lambda (x) 'z))

;;;;----------------------------------------------------------------------------------------------
;;; for a list, make a list of cdrs of the original list
;;;  This is actually just (MAPCON #'LIST l) , but I only found out after I wrote this one.
(defun make-lst-of-cdrs (l)
 (labels ((walk-cdrs (x acc)
            (if (null (cdr x)) acc
                (walk-cdrs (cdr x) (cons (cdr x) acc)))))
   (if (null l) nil      ; we might get an empty list passed in, so hand it right back
       (nreverse (walk-cdrs l (list l))))))
; make-lst-of-cdrs

(setq ll '(1 2 3 4))
;(1 2 3 4)

(make-lst-of-cdrs ll)
;((2 3 4) (3 4) (4))

(make-lst-of-cdrs nil)