#lang scheme/base


(require scheme/control)

; deterministic, left-to-right map
(define (map* f l)
  (if (null? l) l
    (cons (f (car l)) (map* f (cdr l)))))

(define (depth-first handle tree)
    ((null? tree) tree)
    ((handle tree) => (lambda (new-tree) new-tree))
    ; the node was not handled -- descend
    ((not (pair? tree)) tree) ; an atom
      (cons (car tree) 			; node name
	(map* (lambda (kid) (depth-first handle kid)) (cdr tree))))))

(define tree1 '(a (b) (c (d 1 2)) e))
(define tree2 '(z (u) (v (w 10 12)) y))

(define-struct zipper (node k))

(depth-first (lambda (node) (display node) (newline) #f) tree1)

(define (zip-tree tree)
    (lambda (tree)
      (shift f (make-zipper tree f)))

(define (print-tree tree)
  (do ((cursor (zip-tree tree) ((zipper-k cursor) #f)))
      ((not (zipper? cursor)))
    (display (zipper-node cursor))

(define (zip-all-the-way-up zipper)
  (if (zipper? zipper)
       ((zipper-k zipper)
        (zipper-node  zipper)))

(define (locate-nth-node n tree)
  (do ((i 0 (+ 1 i))
       (cursor (zip-tree tree) ((zipper-k cursor) #f)))
    ((and (= i n)
       (if (zipper? cursor) #t
	 (error "too few nodes"))) cursor)

(let ((desired-node (locate-nth-node 3 tree1)))
  (display "Replacing the node: ")
  (display (zipper-node desired-node))
  (zip-all-the-way-up ((zipper-k desired-node) 'xxx)))