blob: f0e397e8751c9ae289585337290997e4e28b194a (
plain) (
blame)
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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
(define srfi-69-dtd
(let ()
(define (t69:make-hash-table* dtd comparator)
(define constructor-args
(if (not comparator)
'()
(let ((pred (comparator-equality-predicate comparator))
(hash (comparator-hash-function comparator)))
(if hash
(list pred hash)
(list pred)))))
(apply t69:make-hash-table constructor-args))
(define (t69:hash-table-ref* dtd table key fail success)
(define default (cons #f #f))
(define found (t69:hash-table-ref/default table key default))
(if (eq? found default)
(fail)
(success found)))
(define (t69:hash-table-set!* dtd table . obj)
(let loop ((obj obj))
(if (null? obj)
table
(begin
(t69:hash-table-set! table (car obj) (cadr obj))
(loop (cddr obj))))))
(define (t69:hash-table-update!/default* dtd table key proc default)
(t69:hash-table-update!/default table key proc default)
table)
(define (t69:hash-table-delete-all!* dtd table keys)
(for-each
(lambda (key)
(t69:hash-table-delete! table key))
keys)
table)
(define (t69:hash-table-foreach* dtd proc table)
(t69:hash-table-walk table proc))
(define (t69:hash-table-map!* dtd proc table)
(t69:hash-table-walk table (lambda (key value)
(t69:hash-table-set! table key (proc key value))))
table)
(define (t69:hash-table-filter!* dtd proc table)
(t69:hash-table-walk table
(lambda (key value)
(unless (proc key value)
(t69:hash-table-delete! table key))))
table)
(define (t69:hash-table-filter* dtd proc table)
(dict-filter! dtd proc (dict-copy dtd table)))
(define (t69:hash-table-fold* dtd proc knil table)
(t69:hash-table-fold table proc knil))
(define (t69:hash-table-search!* dtd table key fail success)
(define (handle-success value)
(define (update new-key new-value obj)
(unless (eq? new-key key)
(t69:hash-table-delete! table key))
(t69:hash-table-set! table new-key new-value)
(values table obj))
(define (remove obj)
(t69:hash-table-delete! table key)
(values table obj))
(success key value update remove))
(define (handle-fail)
(define (ignore obj)
(values table obj))
(define (insert value obj)
(t69:hash-table-set! table key value)
(values table obj))
(fail insert ignore))
(define default (cons #f #f))
(define found (t69:hash-table-ref/default table key default))
(if (eq? default found)
(handle-fail)
(handle-success found)))
(define (t69:hash-table-search* dtd table key fail success)
(t69:hash-table-search!* dtd (dict-copy dtd table) key fail success))
(define (t69:hash-table-values* dtd table)
(t69:hash-table-values table))
(define (t69:hash-table->alist* dtd table)
(t69:hash-table->alist table))
(define (t69:hash-table-keys* dtd table)
(t69:hash-table-keys table))
(define (t69:hash-table-size* dtd table)
(t69:hash-table-size table))
(define (t69:hash-table-exists?* dtd table key)
(t69:hash-table-exists? table key))
(define (t69:hash-table-ref/default* dtd table key default)
(t69:hash-table-ref/default table key default))
(define (t69:hash-table?* dtd table)
(t69:hash-table? table))
(define (t69:hash-table-comparator* dtd table)
(make-comparator (lambda args #t)
(or (t69:hash-table-equivalence-function table)
equal?)
#f
(t69:hash-table-hash-function table)))
(define (t69:hash-table-copy* dtd table)
(t69:hash-table-copy table))
(make-dtd
make-dictionary-index t69:make-hash-table*
dictionary?-index t69:hash-table?*
dict-ref-index t69:hash-table-ref*
dict-ref/default-index t69:hash-table-ref/default*
dict-set!-index t69:hash-table-set!*
dict-delete-all!-index t69:hash-table-delete-all!*
dict-contains?-index t69:hash-table-exists?*
dict-update/default!-index t69:hash-table-update!/default*
dict-size-index t69:hash-table-size*
dict-keys-index t69:hash-table-keys*
dict-values-index t69:hash-table-values*
dict-map!-index t69:hash-table-map!*
dict-filter!-index t69:hash-table-filter!*
dict-filter-index t69:hash-table-filter*
dict-for-each-index t69:hash-table-foreach*
dict-fold-index t69:hash-table-fold*
dict->alist-index t69:hash-table->alist*
dict-search-index t69:hash-table-search*
dict-search!-index t69:hash-table-search!*
dict-comparator-index t69:hash-table-comparator*
dict-copy-index t69:hash-table-copy*)))
|
