SICP_3.25

 1 (define false #f)
 2 (define true #t)
 3 
 4 (define (make-table)
 5   (let ((local-table (list '*table*)))
 6 
 7      (define (assoc key records)
 8       (cond ((null? records) false)
 9             ((equal? (caar records) key) (car records))
10             (else (assoc key (cdr records)))))
11 
12     (define (lookup keys)
13       (define (lookup-helper keys table)
14         (let ((subtable (assoc (car keys) (cdr table))))
15           (if subtable
16               (if (null? (cdr keys))
17                   (cdr subtable)
18                   (lookup-helper (cdr keys) subtable))
19               false)))
20       (lookup-helper keys local-table))
21 
22     (define (insert! keys value)
23       (define (insert-helper! keys table)
24         (if (null? table)
25             (if (null? (cdr keys))
26                 (cons (car keys) value)
27                 (list (car keys) (insert-helper! (cdr keys) '())))
28             (let ((sub (assoc (car keys) (cdr table))))
29               (if sub
30                   (if (null? (cdr keys))
31                       (set-cdr! sub value)
32                       (insert-helper! (cdr keys) sub))
33                   (if (null? (cdr keys))
34                       (set-cdr! table (cons (cons (car keys) value) (cdr table)))
35                       (set-cdr! table (cons
36                                        (list (car keys)(insert-helper! (cdr keys) '()))
37                                        (cdr table))))))))
38       (insert-helper! keys local-table)
39       'ok)
40   
41     (define (dispatch m)
42       (cond ((eq? m 'lookup-proc) lookup)
43             ((eq? m 'insert-proc) insert!)
44             (else (error "Unknow operation --TABLE" m))))
45 
46     dispatch))
47 
48 (define t1 (make-table))
49 
50 ((t1 'insert-proc) '(key1 key2 key4) 5)
51 
52 ((t1 'lookup-proc) '(key1 key2 key4))
Yosoro