-
Notifications
You must be signed in to change notification settings - Fork 0
/
3.24.scm
41 lines (41 loc) · 1.33 KB
/
3.24.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
(define (make-table same-key?)
(let ((local-table (list '*table*)))
(define (assoc key records)
(cond ((null? records) false)
((same-key? key (caar records))
(car records))
(else (assoc key (cdr records)))))
(define (lookup key-1 key-2)
(let ((subtable
(assoc key-1 (cdr local-table))))
(if subtable
(let ((record
(assoc key-2
(cdr subtable))))
(if record (cdr record) false))
false)))
(define (insert! key-1 key-2 value)
(let ((subtable
(assoc key-1 (cdr local-table))))
(if subtable
(let ((record
(assoc key-2
(cdr subtable))))
(if record
(set-cdr! record value)
(set-cdr!
subtable
(cons (cons key-2 value)
(cdr subtable)))))
(set-cdr!
local-table
(cons (list key-1
(cons key-2 value))
(cdr local-table)))))
'ok)
(define (dispatch m)
(cond ((eq? m 'lookup-proc) lookup)
((eq? m 'insert-proc!) insert!)
(else (error "Unknown operation:
TABLE" m))))
dispatch))