1 665c255d 2023-08-04 jrmu (define (make-table)
2 665c255d 2023-08-04 jrmu (define (assoc key records)
3 665c255d 2023-08-04 jrmu (cond ((null? records) false)
4 665c255d 2023-08-04 jrmu ((equal? key (caar records)) (car records))
5 665c255d 2023-08-04 jrmu (else (assoc key (cdr records)))))
6 665c255d 2023-08-04 jrmu (let ((local-table (list '*table*)))
7 665c255d 2023-08-04 jrmu (define (lookup key-list)
8 665c255d 2023-08-04 jrmu (define (lookup1 keys table)
9 665c255d 2023-08-04 jrmu (let ((subtable (assoc (car keys) (cdr table))))
10 665c255d 2023-08-04 jrmu (if subtable
11 665c255d 2023-08-04 jrmu (if (null? (cdr keys))
12 665c255d 2023-08-04 jrmu (cdr subtable)
13 665c255d 2023-08-04 jrmu (lookup1 (cdr keys) subtable))
15 665c255d 2023-08-04 jrmu (lookup1 key-list local-table))
16 665c255d 2023-08-04 jrmu (define (insert! key-list value)
17 665c255d 2023-08-04 jrmu (define (make-entry keys)
18 665c255d 2023-08-04 jrmu (if (null? (cdr keys))
19 665c255d 2023-08-04 jrmu (cons (car keys) value)
20 665c255d 2023-08-04 jrmu (list (car keys) (make-entry (cdr keys)))))
21 665c255d 2023-08-04 jrmu (define (insert1 keys table)
22 665c255d 2023-08-04 jrmu (let ((subtable (assoc (car keys) (cdr table))))
23 665c255d 2023-08-04 jrmu (if subtable
24 665c255d 2023-08-04 jrmu (if (null? (cdr keys))
25 665c255d 2023-08-04 jrmu (set-cdr! subtable value)
26 665c255d 2023-08-04 jrmu (insert1 (cdr keys) subtable))
27 665c255d 2023-08-04 jrmu (set-cdr! table (cons (make-entry keys)
28 665c255d 2023-08-04 jrmu (cdr table))))))
29 665c255d 2023-08-04 jrmu (insert1 key-list local-table)
31 665c255d 2023-08-04 jrmu (define (dispatch m)
32 665c255d 2023-08-04 jrmu (cond ((eq? m 'lookup-proc) lookup)
33 665c255d 2023-08-04 jrmu ((eq? m 'insert-proc!) insert!)
34 665c255d 2023-08-04 jrmu (else (error "Unknown operation -- TABLE" m)))
