Lecture 3 - slide 40 : 43

; ALL PARTS TOGETHER IN ONE FILE - VERY LITTLE NEW STUFF HERE.

; Binary tree stuff:
(define (make-tree left-tree root-node right-tree)
   (list left-tree root-node right-tree))
(define (leaf root-node) (make-tree '() root-node '()))
(define root cadr)
(define left-tree car)
(define right-tree caddr)
(define inner-node? pair?)
(define leaf? number?)
(define empty-tree? null?)

(define (print-node n) (write n) (newline))
(define (TRAV tree)
  (cond ((empty-tree? tree) )
        ((inner-node? tree) 
            (TRAV (left-tree tree))
            (print-node (root tree))
            (TRAV (right-tree tree)))
        ((leaf? tree)
            (print-node (root tree)))
        (else (error "Should not happen"))))

(define tr1 (make-tree (make-tree
                            (leaf 2)
                            4
                            (leaf 3))
                       7
                       (make-tree
                            (make-tree '() 0 (leaf 9))
                            1
                            (leaf 5))))

(define tr2 (make-tree (make-tree
                            (make-tree '() 1 (leaf 9))
                            0
                            (leaf 7))
                       8
                       (make-tree
                            (make-tree (leaf 2) 7 '())
                            6
                            (leaf 1))))

(define (traverse-start tree controller-cont)
  (let ((cont (traverse tree controller-cont)))
    (cont (cons #f 'no-continuation))  ; end of traversal value, passed back to controller.
  ))

; Traverse tree, and send every node encountered to controller-cont.
; Returns a controller continuation.
(define (traverse tree controller-cont)
  (cond ((empty-tree? tree) controller-cont)
        ((inner-node? tree) 
            (let ((new-controller-cont (traverse (left-tree tree) controller-cont)))
              (let ((new-controller-cont (handle-node (root tree) new-controller-cont)))
                (let ((new-controller-cont (traverse (right-tree tree) new-controller-cont)))
                   new-controller-cont))))
        ((leaf? tree)
            (handle-node (root tree) controller-cont))
        (else (error "Should not happen")))
)

; Send n, together with a continuation, to controller-cont.
; Receive a new controller continuation, which is returned by handle-node.
(define (handle-node n controller-cont) 
  (call-with-current-continuation 
    (lambda (here)
       (controller-cont (cons n here)))))

(define (end-traversal? x y)
  (or (and (pair? x) (not (car x)))
      (and (pair? y) (not (car y))) ))

(define (traverse-controller tr1 tr2)
  (let ((tr1-point (call-with-current-continuation (lambda (here) (traverse-start tr1 here))))
        (tr2-point (call-with-current-continuation (lambda (here) (traverse-start tr2 here)))))
    (letrec ((tree-2-stepper 
              (lambda (tr1-point tr2-point)  ; tr1-point and tr2-point are each a pair:
                                             ; (tree-node . traversal-cont)
                (if (end-traversal? tr1-point tr2-point) 
                    '()
                    (let ((n1 (car tr1-point))
                          (c1 (cdr tr1-point))
                          (n2 (car tr2-point))
                          (c2 (cdr tr2-point)))
                       (cons (cons n1 n2)
                          (let ((tr1nh (call-with-current-continuation
                                         (lambda (here) (c1 here))))
                                (tr2nh (call-with-current-continuation
                                         (lambda (here) (c2 here)))))
                            (tree-2-stepper tr1nh tr2nh ))))))))
       (tree-2-stepper tr1-point tr2-point ))))

; (traverse-controller tr1 tr2) =>
; ((2 . 1) (4 . 9) (3 . 0) (7 . 7) (0 . 8) (9 . 2) (1 . 7)   (5 . 6))