2015/11/22

# 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))
;; 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 () ())``````