; binary tree traversal

(define (split-while pred? xs)
  (let loop ((xs xs) (ys '()))
    (if (or (null? xs) (not (pred? (car xs))))
        (values (reverse ys) xs)
        (loop (cdr xs) (cons (car xs) ys)))))

(define (preorder t)
  (if (null? t)
      (list)
      (append (list (car t))
              (if (pair? (cdr t))
                  (preorder (cadr t))
                  (list))
              (if (and (pair? (cdr t))
                       (pair? (cddr t)))
                  (preorder (caddr t))
                  (list)))))

(define (postorder t)
  (if (null? t)
      (list)
      (append (if (pair? (cdr t))
                  (postorder (cadr t))
                  (list))
              (if (and (pair? (cdr t))
                       (pair? (cddr t)))
                  (postorder (caddr t))
                  (list))
              (list (car t)))))

(define (last xs) (car (reverse xs)))

(define (but-last xs) (reverse (cdr (reverse xs))))

(define (prebuild xs)
  (cond ((null? xs) (list))
        ((null? (cdr xs)) (list (car xs)))
        (else (call-with-values
          (lambda ()
            (split-while
              (lambda (x) (< x (car xs))) (cdr xs)))
          (lambda (lo hi)
            (list (car xs) (prebuild lo) (prebuild hi)))))))

(define (postbuild xs)
  (cond ((null? xs) (list))
        ((null? (cdr xs)) (list (car xs)))
        (else (call-with-values
          (lambda ()
            (split-while
              (lambda (x) (< x (last xs))) (but-last xs)))
          (lambda (lo hi)
            (list (last xs) (postbuild lo) (postbuild hi)))))))

(define t '(8 (3 (1) (6 (4) (7))) (10 () (14 (13) ()))))

(display (preorder t)) (newline)
(display (postorder t)) (newline)
(display (prebuild (preorder t))) (newline)
(display (postbuild (postorder t))) (newline)

(8 3 1 6 4 7 10 14 13)
(1 4 7 6 3 13 14 10 8)
(8 (3 (1) (6 (4) (7))) (10 () (14 (13) ())))
(8 (3 (1) (6 (4) (7))) (10 () (14 (13) ())))