blob: 1929bedfa24b15fefa82592cef3e541ab0130ac4 (
plain)
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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
#lang racket
(require compatibility/mlist)
(define (make-2d-table same-key?)
(let ((local-table (mlist '*table*)))
(define (assoc key records)
(cond ((null? records) false)
((same-key? key (mcar (mcar records))) (mcar records))
(else (assoc key (mcdr records)))))
(define (lookup key-1 key-2)
(let ((subtable (assoc key-1 (mcdr local-table))))
(if subtable
(let ((record (assoc key-2 (mcdr subtable))))
(if record
(mcdr record)
false))
false)))
(define (insert! key-1 key-2 value)
(let ((subtable (assoc key-1 (mcdr local-table))))
(if subtable
(let ((record (assoc key-2 (mcdr subtable))))
(if record
(set-mcdr! record value)
(set-mcdr! subtable
(mcons (mcons key-2 value)
(mcdr subtable)))))
(set-mcdr! local-table
(mcons (mlist key-1 (mcons key-2 value)) (mcdr local-table)))))
'ok)
(define (dispatch m)
(cond ((eq? m 'lookup-proc) lookup)
((eq? m 'insert-proc) insert!)
(else (error "Unknown operation -- TABLE" m))))
dispatch))
(define tbl (make-2d-table (lambda (a b) (equal? a b))))
((tbl 'insert-proc) 'test 'message "hi")
((tbl 'lookup-proc) 'test 'message)
(define (make-general-table same-key?)
(let ((local-table (mlist '*table*)))
(define (assoc key records)
(cond ((null? records) false)
((same-key? key (mcar (mcar records))) (mcar records))
(else (assoc key (mcdr records)))))
(define (lookup keys) (mcdr (foldl (lambda (key tbl) (assoc key (mcdr tbl))) local-table keys)))
(define (insert! keys value)
(set-mcdr!
(foldl (lambda (key tbl)
(let ((subtable (assoc key (mcdr tbl))))
(if subtable
subtable
(let ((empty-record (mlist key)))
(set-mcdr! tbl (mcons empty-record (mcdr tbl)))
empty-record))))
local-table
keys)
value)
'ok)
(define (dispatch m)
(cond ((eq? m 'lookup-proc) lookup)
((eq? m 'insert-proc) insert!)
(else (error "Unknown operation -- TABLE" m))))
dispatch))
(define gentbl (make-general-table (lambda (a b) (equal? a b))))
((gentbl 'insert-proc) '(test message) "hi")
((gentbl 'lookup-proc) '(test message))
;; Example table could be represented as a binary tree on the keys
;; '((B value) (((A value) () ()))
;; (((C value) () ())))
;; The insert and lookup procedure can then just be implemented using the element-of-set? and adjoin-set methods if the entry selector is adjusted for the (key value) format
|
