(define (make-table less-than?) (define (make-node key value left right) (list key value left right)) (define (make-leaf key value) (make-node key value '() '())) (define (node-key node) (car node)) (define (node-value node) (cadr node)) (define (set-value! node value) (set-car! (cdr node) value)) (define (left-child node) (caddr node)) (define (right-child node) (cadddr node)) (define (set-left-child! node child) (set-car! (cddr node) child)) (define (set-right-child! node child) (set-car! (cdddr node) child)) (define root '()) (define (lookup-value key node) (cond ((null? node) false) ((less-than? key (node-key node)) (lookup-value key (left-child node))) ((less-than? (node-key node) key) (lookup-value key (right-child node))) (else (node-value node)))) (define (lookup key) (lookup-value key root)) (define (insert key value node) (cond ((null? node) (make-leaf key value)) ((less-than? key (node-key node)) (set-left-child! node (insert key value (left-child node))) node) ((less-than? (node-key node) key) (set-right-child! node (insert key value (right-child node))) node) (else (set-value! node value) node))) (define (insert! key value) (set! root (insert key value root)) 'ok) (define (dispatch m) (cond ((eq? m 'lookup-proc) lookup) ((eq? m 'insert-proc) insert!) (else (error "Unknown operation -- TABLE" m)))) dispatch) (define (lookup key table) ((table 'lookup-proc) key)) (define (insert! key value table) ((table 'insert-proc) key value)) ; 1 ]=> (define t (make-table string (map (lambda(x) (insert! (car x) (cadr x) t)) '(("January" 1) ("February" 2) ("March" 3) ("April" 4) ("May" 5) ("June" 6) ("July" 7) ("August" 8) ("September" 9) ("October" 10) ("November" 11) ("December" 12))) ; ; ;Value: (ok ok ok ok ok ok ok ok ok ok ok ok) ; ; 1 ]=> (map (lambda(month) (lookup month t)) '("January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December")) ; ; ;Value: (1 2 3 4 5 6 7 8 9 10 11 12) ; ; 1 ]=> (lookup "jan" t) ; ; ;Value: #f