gistfile1.scm

#lang scheme

(require scheme/control)

(define (identity x)
  x)

(define (map* fun lst)
  (cond [(empty? lst) lst]
        [else (cons (fun (first lst))
                    (map* fun (rest lst)))]))

(define (depth-first fun tree)
  (cond [(empty? tree) tree]
        [(fun tree) => identity]
        ; node was not handled; descend
        [(not (pair? tree)) tree]
        [else (cons (first tree) ; node name
                    (map* (λ (child)
                            (depth-first fun child))
                          (rest tree)))]))

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

(define-struct zipper (curr-node cont))

(define (zip-tree tree)
  (reset (depth-first (λ (tree) 
                        (shift f (make-zipper tree f))) 
                      tree)))

(define (print-tree tree)
  (do ([cursor (zip-tree tree) ((zipper-cont cursor) #f)])
      ((not (zipper? cursor)))
    (display (zipper-curr-node cursor))
    (newline)))