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