(define (make-table same-key?)
(let ((local-table (list '*table*)))
(define (assoc2 key records test)
(cond ((null? records) #f)
((test key (caar records)) (car records))
(else (assoc2 key (cdr records) test))))
(define (lookup-iter keys table)
(if (null? keys)
(cdr table)
(let ((subtable (assoc2 (car keys) (cdr table) same-key?)))
(if subtable
(lookup-iter (cdr keys) subtable)
#f))))
(define (lookup keys)
(lookup-iter keys local-table))
(define (compose-table keys value)
(if (null? (cdr keys))
(cons (car keys) value)
(list (car keys) (compose-table (cdr keys) value))))
(define (insert!-iter keys value table)
(let ((subtable (assoc2 (car keys) (cdr table) same-key?)))
(if subtable
(if (null? (cdr keys))
(set-cdr! subtable value)
(insert!-iter (cdr keys) value subtable))
(set-cdr! table
(cons (compose-table keys value)
(cdr table))))))
(define (insert! keys value)
(insert!-iter keys value local-table)
'ok)
(define (dispatch m)
(cond ((eq? m 'lookup-proc) lookup)
((eq? m 'insert-proc!) insert!)
(else (error "Unknown operation -- TABLE" m))))
dispatch))
(define ot (make-table eq?))
(define get (ot 'lookup-proc))
(define put (ot 'insert-proc!))
(get '(a b c))
(put '(a b c) 'a-b-c-value)
(put '(a d c) 'a-d-c-value)
(put '(c d e f) 'c-d-e-f-value)
(put '(x y z) 'x-y-z-value)
(get '(a b c))
(get '(a d c))
(get '(x y z))
(get '(c d e f))