exercise 3.26

最初に「解けた！」と思ったときは、実は単に2.66解いてただけだと分かって、適当に書き直すもうまく動かず。その後結局解答をチラッと見て、なんとかできた。
…いろいろと書きたいことはあるが疲れたので、とりあえずコード貼り付けるだけ

(define (make-tree)
  (let ((tree'empty-tree))
    (define (make-sub-tree key value left right)
      (list key value left right))
     ;;セレクタ
     (define (key-name tree)
       (car tree))
     (define (value tree)
       (cadr tree))
     (define (left-branch tree)
       (caddr tree))
     (define (right-branch tree)
       (cadddr tree))
  
    ;;set-hogehoge!みたいな
     (define (set-value! tree new-value)
       (set-car!  (cdr tree) new-value))
     (define (set-left! tree left)
       (set-car! (cddr tree) left))
     (define (set-right! tree right)
       (set-car! (cdddr tree) right))

     (define (look-up key)
      (define (look-up-iter key records)
        (cond ((eq? tree 'empty-tree) #f)
              ((null? records) #f)
              ((= key (key-name records)) (value records))
              ((< key (key-name records))
               (look-up-iter key (left-branch records)))
              ((> key (key-name records))
               (look-up-iter key (right-branch records)))))
      (look-up-iter key tree))
    (define (insert! key value)
      (define (insert-iter! key value records)
        (cond ((eq? records 'empty-tree)
               (set! tree (make-sub-tree key value '() '())))
              ((= key (key-name records))
               (set-value! records value))
              ((< key (key-name records))
               (if (null? (left-branch records))
                   (set-left! records (make-sub-tree key value '() '()))
                   (insert-iter! key value (left-branch records))))
              ((> key (key-name records))
               (if (null? (right-branch records))
                   (set-right! records (make-sub-tree key value '() '()))
                   (insert-iter! key value (right-branch records))))))
      (insert-iter! key value tree))
    (define (print-tree)
      (print tree))
    (define (dispatch m)
      (cond ((eq? m 'look-up) look-up)
            ((eq? m 'insert!) insert!)
            ((eq? m 'print-tree) (print-tree))
            (else (error "Undefined operation -- MAKE TREE" m))))
    dispatch))

(define (print-tree a) (a 'print-tree))
(define (insert! key value a) ((a 'insert!) key value))
(define (look-up key a) ((a 'look-up) key))

実行結果

gosh> (define c (make-tree))                                                                               
c                                                                                                          
gosh> (insert! 4 4 c)                                                                                      
(4 4 () ())                                                                                                
gosh> (print-tree c)                                                                                       
(4 4 () ())                                                                                                
#<undef>                                                                                                   
gosh> (insert! 2 2 c)                                                                                      
#<undef>                                                                                                   
gosh> (insert! 1 1 c)                                                                                      
#<undef>                                                                                                   
gosh> (insert! 3 3 c)                                                                                      
#<undef>                                                                                                   
gosh> (insert! 6 6 c)                                                                                      
#<undef>                                                                                                   
gosh> (insert! 5 5 c)                                                                                      
#<undef>                                                                                                   
gosh> (insert! 7 7 c)                                                                                      
#<undef>                                                                                                   
gosh> (print-tree c)                                                                                       
(4 4 (2 2 (1 1 () ()) (3 3 () ())) (6 6 (5 5 () ()) (7 7 () ())))                                          
#<undef>                                                                                                   
gosh> (look-up 5 c)                                                                                        
5                                                                                                          
gosh> (look-up 3 c)                                                                                        
3