;; A Tree is a (Msg -> Procedure)
;; where Msg is one of:
;; - 'left      => (Self -> Tree)
;; - 'right     => (Self -> Tree)
;; - 'is-leaf   => (Self -> Boolean)
;; - 'node-val  => (Self -> Value)
;; - 'make-node => (Self * Tree * Value -> Tree)
;; 
;; plus the abstract methods that Collection needs implemented:
;; - 'is-empty
;; - 'add-elem
;; - 'some-elem

;; (When viewing these Trees as collections, the values are held at
;; nodes; leaves have no values and thus are the empty collections.)

(define leaf      'constructor-defined-below)
(define left      (lambda (t) ((t 'left)  t)))
(define right     (lambda (t) ((t 'right) t)))
(define isLeaf    (lambda (t) ((t 'is-leaf) t)))
(define nodeValue (lambda (t) ((t 'node-val) t)))
(define node (lambda (t1 t2 val) ((t1 'make-node) t1 t2 val)))

;; We're going to need some stuff defined in here:
(load "collection-delegate.scm")

(letrec ((abstract-tree ;; -> Tree
          ;; This will be another abstract class that handles 
          ;; implementing the Collection methods in terms of 
          ;; the methods of Tree.
          (lambda ()
            ;; Our "superclass" is Collection, so make one to handle 
            ;; any messages we don't know about.
            (let ((super (base-collection)))
              (lambda (sym)
                
                (cond 
                 ;; These are the three "abstract methods" that we are
                 ;; responsible for implementing if we want to claim
                 ;; to be a concretely implemented subclass of
                 ;; Collection.
                 ((eq? sym 'is-empty) (lambda (self) (isLeaf self)))
                 ((eq? sym 'add-elem) (lambda (self v)
                                        (node self (leaf) v)))
                 ((eq? sym 'some-elem)
                  ;; (This one is a bit trickier than Felix would like...)
                  (lambda (self) 
                    (cond 
                     ((isLeaf self) 
                      (error 'cant-use-some-elem-on-empty-trees!))
                     ((isLeaf (left self))
                      (list (nodeValue self) (right self)))
                     ((isLeaf (right self))
                      (list (nodeValue self) (left self)))
                     (else (let* ((val-and-rest (anyElem (left self)))
                                  (lft-val  (list-ref val-and-rest 0))
                                  (lft-rest (list-ref val-and-rest 1)))
                             (list lft-val (node lft-rest
                                                 (right self)
                                                 (nodeValue self))))))))
                 
                 (else        ;; For any other messages we pass the buck up to
                  (super sym) ;; superclass; ask it what it wants to do here.
                  ))))))
          
         (node-fields->object ;; Tree Tree Value -> Tree
          (lambda (lft rgt val)
            (let ((super (abstract-tree)))
              (lambda (sym)
                (cond 
                 ((eq? sym 'is-leaf)    (lambda (self) #f))
                 ((eq? sym 'left)       (lambda (self) lft))
                 ((eq? sym 'right)      (lambda (self) rgt))
                 ((eq? sym 'node-val)   (lambda (self) val))
                 ((eq? sym 'make-node)
                  (lambda (self t2 val)
                    (node-fields->object self t2 val)))
                 
                 
                 (else        ;; For any other messages we pass the buck up to
                  (super sym) ;; superclass; ask it what it wants to do here.
                  ))))))

         (leaf->object ;; -> Tree
          (lambda ()
            (let ((super (abstract-tree)))
              (lambda (sym)
                (cond 
                 ((eq? sym 'is-leaf)     (lambda (self) #t))
                 ((eq? sym 'make-node)
                  (lambda (self t2 val)
                    (node-fields->object self t2 val)))
                 
                 (else        ;; For any other messages we pass the buck up to
                  (super sym) ;; superclass; ask it what it wants to do here.
                  )))))))
  (set! leaf 
        (lambda () (leaf->object)))
  )