SICP_3.24

 1 (define (make-table key-same?)
 2   (let ((local-table (list ‘*table*)))
 3 
 4     
 5     (define (assoc key records)
 6       (cond ((null? records) #f)
 7             ((key-same? (caar records) key) (car records))
 8             (else (assoc key (cdr records)))))
 9 
10     (define (lookup key-1 key-2)
11       (let ((subtable (assoc key-1 (cdr local-table))))
12         (if subtable
13             (let ((record (assoc key-2 (cdr subtable))))
14               (if record
15                   (cdr record)
16                   false))
17             false)))
18 
19     (define (insert! key-1 key-2 value)
20       (let ((subtable (assoc key-1 (cdr local-table))))
21         (if subtable
22             (let ((record (assoc key-2 (cdr subtable))))
23               (if record
24                   (set-cdr! record value)
25                   (set-cdr! subtable (cons (cons key-2 value)
26                                            (cdr subtable)))))
27             (set-cdr! local-table
28                       (cons (list key-1 (cons key-2 value))
29                             (cdr local-table)))))
30       ‘ok)
31 
32     (define (dispatch m)
33       (cond ((eq? m ‘lookup-proc) lookup)
34             ((eq? m ‘insert-proc!) insert!)
35             (else (error "Unknow operation --TABLE" m))))
36 
37     dispatch))