; CONTROLLER STUFF: ; Control and drive the simultaneous pre-order traversals of tr1 and tr2. ; Return a list of pairs (n1 . n2) where n1 comes from tr1 and n2 comes from tr2. ; Stop when one of the trees are exhausted. (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 ((tr1-nxt-point (call-with-current-continuation (lambda (here) (c1 here)))) (tr2-nxt-point (call-with-current-continuation (lambda (here) (c2 here))))) (tree-2-stepper tr1-nxt-point tr2-nxt-point )))))))) (tree-2-stepper tr1-point tr2-point )))) (define (end-traversal? x y) (or (and (pair? x) (not (car x))) (and (pair? y) (not (car y))) )) ; (traverse-controller tr1 tr2) => ; ((2 . 1) (4 . 9) (3 . 0) (7 . 7) (0 . 8) (9 . 2) (1 . 7) (5 . 6))