1 665c255d 2023-08-04 jrmu (define (lookup key table)
 2 665c255d 2023-08-04 jrmu   (let ((record (assoc key (cdr table))))
 3 665c255d 2023-08-04 jrmu     (if record
 4 665c255d 2023-08-04 jrmu 	(cdr record)
 5 665c255d 2023-08-04 jrmu 	false)))
 6 665c255d 2023-08-04 jrmu (define (assoc key records)
 7 665c255d 2023-08-04 jrmu   (cond ((null? records) false)
 8 665c255d 2023-08-04 jrmu 	((equal? key (caar records)) (car records))
 9 665c255d 2023-08-04 jrmu 	(else (assoc key (cdr records)))))
10 665c255d 2023-08-04 jrmu (define (insert! key value table)
11 665c255d 2023-08-04 jrmu   (let ((record (assoc key (cdr table))))
12 665c255d 2023-08-04 jrmu     (if record
13 665c255d 2023-08-04 jrmu 	(set-cdr! record value)
14 665c255d 2023-08-04 jrmu 	(set-cdr! table
15 665c255d 2023-08-04 jrmu 		  (cons (cons key value) (cdr table)))))
16 665c255d 2023-08-04 jrmu   'ok)
17 665c255d 2023-08-04 jrmu (define (make-table)
18 665c255d 2023-08-04 jrmu   (list '*table*))
19 665c255d 2023-08-04 jrmu 
20 665c255d 2023-08-04 jrmu (define (lookup key-1 key-2 table)
21 665c255d 2023-08-04 jrmu   (let ((subtable (assoc key-1 (cdr table))))
22 665c255d 2023-08-04 jrmu     (if subtable
23 665c255d 2023-08-04 jrmu 	(let ((record (assoc key-2 (cdr subtable))))
24 665c255d 2023-08-04 jrmu 	  (if record
25 665c255d 2023-08-04 jrmu 	      (cdr record)
26 665c255d 2023-08-04 jrmu 	      false))
27 665c255d 2023-08-04 jrmu 	false)))
28 665c255d 2023-08-04 jrmu (define (insert! key-1 key-2 value table)
29 665c255d 2023-08-04 jrmu   (let ((subtable (assoc key-1 (cdr table))))
30 665c255d 2023-08-04 jrmu     (if subtable
31 665c255d 2023-08-04 jrmu 	(let ((record (assoc key-2 (cdr subtable))))
32 665c255d 2023-08-04 jrmu 	  (if record
33 665c255d 2023-08-04 jrmu 	      (set-cdr! record value)
34 665c255d 2023-08-04 jrmu 	      (set-cdr! subtable
35 665c255d 2023-08-04 jrmu 			(cons (cons key-2 value)
36 665c255d 2023-08-04 jrmu 			      (cdr subtable)))))
37 665c255d 2023-08-04 jrmu 	(set-cdr! table
38 665c255d 2023-08-04 jrmu 		  (cons (list key-1 (cons key-2 value))
39 665c255d 2023-08-04 jrmu 			(cdr table)))))
40 665c255d 2023-08-04 jrmu   'ok)
41 665c255d 2023-08-04 jrmu 
42 665c255d 2023-08-04 jrmu 
43 665c255d 2023-08-04 jrmu ;; didn't finish
44 665c255d 2023-08-04 jrmu 
45 665c255d 2023-08-04 jrmu (define (make-table)
46 665c255d 2023-08-04 jrmu   (let ((local-table (list '*table*)))
47 665c255d 2023-08-04 jrmu     (define (lookup key-1 key-2)
48 665c255d 2023-08-04 jrmu       (let ((subtable (assoc key-1 (cdr local-table))))
49 665c255d 2023-08-04 jrmu         (if subtable
50 665c255d 2023-08-04 jrmu             (let ((record (assoc key-2 (cdr subtable))))
51 665c255d 2023-08-04 jrmu               (if record
52 665c255d 2023-08-04 jrmu                   (cdr record)
53 665c255d 2023-08-04 jrmu                   false))
54 665c255d 2023-08-04 jrmu             false)))
55 665c255d 2023-08-04 jrmu     (define (insert! key-1 key-2 value)
56 665c255d 2023-08-04 jrmu       (let ((subtable (assoc key-1 (cdr local-table))))
57 665c255d 2023-08-04 jrmu         (if subtable
58 665c255d 2023-08-04 jrmu             (let ((record (assoc key-2 (cdr subtable))))
59 665c255d 2023-08-04 jrmu               (if record
60 665c255d 2023-08-04 jrmu                   (set-cdr! record value)
61 665c255d 2023-08-04 jrmu                   (set-cdr! subtable
62 665c255d 2023-08-04 jrmu                             (cons (cons key-2 value)
63 665c255d 2023-08-04 jrmu                                   (cdr subtable)))))
64 665c255d 2023-08-04 jrmu             (set-cdr! local-table
65 665c255d 2023-08-04 jrmu                       (cons (list key-1
66 665c255d 2023-08-04 jrmu                                   (cons key-2 value))
67 665c255d 2023-08-04 jrmu                             (cdr local-table)))))
68 665c255d 2023-08-04 jrmu       'ok)    
69 665c255d 2023-08-04 jrmu     (define (dispatch m)
70 665c255d 2023-08-04 jrmu       (cond ((eq? m 'lookup-proc) lookup)
71 665c255d 2023-08-04 jrmu             ((eq? m 'insert-proc!) insert!)
72 665c255d 2023-08-04 jrmu             (else (error "Unknown operation -- TABLE" m))))
73 665c255d 2023-08-04 jrmu     dispatch))
74 665c255d 2023-08-04 jrmu (define operation-table (make-table))
75 665c255d 2023-08-04 jrmu (define get (operation-table 'lookup-proc))
76 665c255d 2023-08-04 jrmu (define put (operation-table 'insert-proc!))
77 665c255d 2023-08-04 jrmu 
78 665c255d 2023-08-04 jrmu  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.