SICP 問題 3.26

(define (make-table)
  ;; tree
  (define (make-tree key value left-branch right-branch)
    (list key value left-branch right-branch))
  ;; 選択子
  (define (key-tree tree) (car tree))
  (define (value-tree tree) (cadr tree))
  (define (left-branch tree) (caddr tree))
  (define (right-branch tree) (cadddr tree))
  ;; set
  (define (set-value! value tree)
    (set-car! (cdr tree) value))
  (define (set-left-branch! left tree)
    (set-car! (cddr tree) left))
  (define (set-right-branch! right tree)
    (set-car! (cdddr tree) right))

  (let ((local-table (make-tree '*table* '() '() '())))
    (define (lookup key-list)
      (let iter ((key-list key-list)
                 (table local-table))
        (cond ((null? table) false)
              ((= (car key-list) (key-tree table))
               (if (null? (cdr key-list))
                   table
                   (iter (cdr key-list) (value-tree table))))
              ((< (car key-list) (key-tree table))
               (iter key-list (left-branch table)))
              ((> (car key-list) (key-tree table))
               (iter key-list (right-branch table))))))

    (define (insert! key-list value)
      (let iter ((key-list key-list)
                 (table local-table))
        (cond ((eq? (key-tree local-table) '*table*)
               (set! local-table (insert-iter! key-list value)))
              ((= (car key-list) (key-tree table))
               (set-value! (insert-iter! key-list value) table))
              ((< (car key-list) (key-tree table))
               (if (null? (left-branch table))
                   (set-left-branch! (insert-iter! key-list value) table)
                   (iter key-list (left-branch table))))
              ((> (car key-list) (key-tree table))
               (if (null? (right-branch table))
                   (set-right-branch! (insert-iter! key-list value) table)
                   (iter key-list (right-branch table))))))
      'done)

    (define (insert-iter! key-list value)
      (if (null? (cdr key-list))
          (make-tree (car key-list) value '() '())
          (make-tree (car key-list)
                     (insert-iter! (cdr key-list) value) '() '())))

    (define (printing)
      (display local-table)
      (newline))

    (define (dispatch m)
      (cond ((eq? m 'lookup) lookup)
            ((eq? m 'insert!) insert!)
            ((eq? m 'printing) (printing))
            (else ((error "Unknown operation --TABLE" m)))))
  dispatch))

(define (lookup table key-list)
  ((table 'lookup) key-list))

(define (insert! table key-list value)
  ((table 'insert!) key-list value))

(define (printing table)
  (table 'printing))

gosh> (define t1 (make-table))
t1
gosh> (insert! t1 '(1 3) 'a)
done
gosh> (printing t1)
(1 (3 a () ()) () ())
#<undef>
gosh> (lookup t1 '(1 3))
(3 a () ())