1 (define (lookup key table)
2   (let ((record (assoc key (cdr table))))
3     (if record
4 	(cdr record)
5 	false)))
6 (define (assoc key records)
7   (cond ((null? records) false)
8 	((equal? key (caar records)) (car records))
9 	(else (assoc key (cdr records)))))
10 (define (insert! key value table)
11   (let ((record (assoc key (cdr table))))
12     (if record
13 	(set-cdr! record value)
14 	(set-cdr! table
15 		  (cons (cons key value) (cdr table)))))
16   'ok)
17 (define (make-table)
18   (list '*table*))
19 
20 (define (lookup key-1 key-2 table)
21   (let ((subtable (assoc key-1 (cdr table))))
22     (if subtable
23 	(let ((record (assoc key-2 (cdr subtable))))
24 	  (if record
25 	      (cdr record)
26 	      false))
27 	false)))
28 (define (insert! key-1 key-2 value table)
29   (let ((subtable (assoc key-1 (cdr table))))
30     (if subtable
31 	(let ((record (assoc key-2 (cdr subtable))))
32 	  (if record
33 	      (set-cdr! record value)
34 	      (set-cdr! subtable
35 			(cons (cons key-2 value)
36 			      (cdr subtable)))))
37 	(set-cdr! table
38 		  (cons (list key-1 (cons key-2 value))
39 			(cdr table)))))
40   'ok)
41 
42 
43 ;; didn't finish
44 
45 (define (make-table)
46   (let ((local-table (list '*table*)))
47     (define (lookup key-1 key-2)
48       (let ((subtable (assoc key-1 (cdr local-table))))
49         (if subtable
50             (let ((record (assoc key-2 (cdr subtable))))
51               (if record
52                   (cdr record)
53                   false))
54             false)))
55     (define (insert! key-1 key-2 value)
56       (let ((subtable (assoc key-1 (cdr local-table))))
57         (if subtable
58             (let ((record (assoc key-2 (cdr subtable))))
59               (if record
60                   (set-cdr! record value)
61                   (set-cdr! subtable
62                             (cons (cons key-2 value)
63                                   (cdr subtable)))))
64             (set-cdr! local-table
65                       (cons (list key-1
66                                   (cons key-2 value))
67                             (cdr local-table)))))
68       'ok)    
69     (define (dispatch m)
70       (cond ((eq? m 'lookup-proc) lookup)
71             ((eq? m 'insert-proc!) insert!)
72             (else (error "Unknown operation -- TABLE" m))))
73     dispatch))
74 (define operation-table (make-table))
75 (define get (operation-table 'lookup-proc))
76 (define put (operation-table 'insert-proc!))
77 
78  Exercise 3.24.  In the table implementations above, the keys are tested for equality using equal? (called by assoc). This is not always the appropriate test. For instance, we might have a table with numeric keys in which we don't need an exact match to the number we're looking up, but only a number within some tolerance of it. Design a table constructor make-table that takes as an argument a same-key? procedure that will be used to test ``equality'' of keys. Make-table should return a dispatch procedure that can be used to access appropriate lookup and insert! procedures for a local table.