3.26

2分木のレコード
keyは一つしかとれない。
こんな感じでいいのかな？

(define (make-tree-table init)
  (let ((tree (list init '() '())))
    (define (make-tree x left right)
      (list x left right))
    (define (entry tree)  (car tree))
    (define (left tree)  (cadr tree))
    (define (right tree)  (caddr tree))
  ;;無駄に高階関数化
    (define (tree-walker key tree nil-f true-f bigger-f smaller-f)
      (if (null? tree)
        (nil-f)
        (let* ((e (entry tree))
               (ek (car e))) 
          (if (= ek key)
              (true-f e)
              (let ((l (left tree))
                    (r (right tree)))
                (if (< ek key)
                      (bigger-f e l r)
                      (smaller-f e l r)))))))
    ;;関数を使う時に処理の順序を意識しなくてすむ。
    ;;ただ、楽かどうかはわからない。
    ;;このままだと引数の順番を覚えておく必要がありそう。
  (define (adjoin-tree key value)
    (define (adjoin target)
      (tree-walker key target
                   (lambda ()
                     (set! target
                           (make-tree (cons key value) '() '())))
                   (lambda (e) (set-cdr! e value)
                           target)
                   (lambda (e l r) (set! tree (make-tree e l (adjoin r))))
                   (lambda (e l r) (set! tree (make-tree e (adjoin l) r)))))
    (adjoin tree)
    'ok)
  (define (lookup-tree key)
    (define (lookup target)
      (tree-walker key target
                   (lambda () #f)
                   (lambda (e) (cdr e))
                   (lambda (e l r) (lookup r))
                   (lambda (e l r) (lookup l))))
    (lookup tree))
    (define (inspect)
      (print tree))
    (define  (dispatch m)
      (cond ((eq? m 'lookup-proc) lookup-tree)
            ((eq? m 'insert-proc!) adjoin-tree)
            ((eq? m 'inspect-proc) inspect)
            (else (error "not found functioni" m))))
    dispatch))
(define mt (make-tree-table (cons 5 5)))
((mt 'insert-proc!) 3 3)
((mt 'insert-proc!) 7 7)
((mt 'insert-proc!) 6 6)
((mt 'inspect-proc))
((mt 'lookup-proc) 6)
((mt 'lookup-proc) 2)
((mt 'insert-proc!) 6 8)
((mt 'inspect-proc))
	;; 18:user> => mt
	;; 19:user> => ok
	;; 20:user> => ok
	;; 21:user> => ok
	;; 22:user> ((5 . 5) ((3 . 3) () ()) ((7 . 7) ((6 . 6) () ()) ()))
	;; => #<undef>
	;; 23:user> => 6
	;; 24:user> => #f
	;; 25:user> => ok
	;; 26:user> ((5 . 5) ((3 . 3) () ()) ((7 . 7) ((6 . 8) () ()) ()))