blob: 57056132c008f9df9127e063972c56846492fa39 (
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
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
|
(define hash-table-dtd
(let ()
(define-syntax guard-immutable
(syntax-rules ()
((_ table body ... final-expr)
(if (t125-hash-table-mutable? table)
(let ()
body ...
final-expr)
(let ((table (t125-hash-table-copy table #t)))
body ...
(let ((table (t125-hash-table-copy table #f)))
final-expr))))))
(define (t125-hash-table-mutable?* dtd table)
(t125-hash-table-mutable? table))
(define (t125-hash-table-set* dtd table . obj)
(guard-immutable table
(apply t125-hash-table-set! (cons table obj))
table))
(define (t125-hash-table-update* dtd table key updater fail success)
(guard-immutable table
(t125-hash-table-update! table key updater fail success)
table))
(define (t125-hash-table-update/default* dtd table key proc default)
(guard-immutable table
(t125-hash-table-update!/default table key proc default)
table))
(define (t125-hash-table-intern* dtd table key failure)
(guard-immutable table
(define val (t125-hash-table-intern! table key failure))
(values table val)))
(define (t125-hash-table-pop* dtd table)
(if (t125-hash-table-empty? table)
(error "popped empty dictionary")
(guard-immutable table
(define-values
(key value)
(t125-hash-table-pop! table))
(values table key value))))
(define (t125-hash-table-delete-all* dtd table keys)
(guard-immutable table
(for-each
(lambda (key)
(t125-hash-table-delete! table key))
keys)
table))
(define (t125-hash-table-map* dtd proc table)
(guard-immutable table
(t125-hash-table-map! proc table)
table))
(define (t125-hash-table-filter* dtd proc table)
(guard-immutable table
(t125-hash-table-prune!
(lambda (key value)
(not (proc key value)))
table)
table))
(define (t125-hash-table-remove* dtd proc table)
(guard-immutable table
(t125-hash-table-prune! proc table)
table))
(define (t125-hash-table-alter* dtd table key fail success)
(define (handle-success value)
(define (update new-key new-value)
(guard-immutable table
(unless (eq? new-key key)
(t125-hash-table-delete! table key))
(t125-hash-table-set! table new-key new-value)
table))
(define (remove)
(guard-immutable table
(t125-hash-table-delete! table key)
table))
(success key value update remove))
(define (handle-fail)
(define (ignore)
table)
(define (insert value)
(guard-immutable table
(t125-hash-table-set! table key value)
table))
(fail insert ignore))
(define default (cons #f #f))
(t125-hash-table-ref table key handle-fail handle-success))
(define (t125-hash-table-comparator* dtd table)
(make-comparator (lambda args #t)
(t125-hash-table-equivalence-function table)
#f
(t125-hash-table-hash-function table)))
(define (t125-hash-table-copy* dtd table)
(t125-hash-table-copy table #t))
(define (t125-hash-table-size* dtd table)
(t125-hash-table-size table))
(define (t125-hash-table-for-each* dtd proc table)
(t125-hash-table-for-each proc table))
(define (t125-hash-table-keys* dtd table)
(t125-hash-table-keys table))
(define (t125-hash-table-values* dtd table)
(t125-hash-table-values table))
(define (t125-hash-table-entries* dtd table)
(t125-hash-table-entries table))
(define (t125-hash-table-fold* dtd proc knil table)
(t125-hash-table-fold proc knil table))
(define (t125-hash-table-map->list* dtd proc table)
(t125-hash-table-map->list proc table))
(define (t125-hash-table->alist* dtd table)
(t125-hash-table->alist table))
(define (t125-hash-table?* dtd table)
(t125-hash-table? table))
(define (t125-hash-table-empty?* dtd table)
(t125-hash-table-empty? table))
(define (t125-hash-table-contains?* dtd table key)
(t125-hash-table-contains? table key))
(define (t125-hash-table-ref* dtd table key failure success)
(t125-hash-table-ref table key failure success))
(define (t125-hash-table-ref/default* dtd table key default)
(t125-hash-table-ref/default table key default))
(make-dtd
dictionary?-id t125-hash-table?*
dict-mutable?-id t125-hash-table-mutable?*
dict-empty?-id t125-hash-table-empty?*
dict-contains?-id t125-hash-table-contains?*
dict-ref-id t125-hash-table-ref*
dict-ref/default-id t125-hash-table-ref/default*
dict-set-id t125-hash-table-set*
dict-delete-all-id t125-hash-table-delete-all*
dict-intern-id t125-hash-table-intern*
dict-update-id t125-hash-table-update*
dict-update/default-id t125-hash-table-update/default*
dict-pop-id t125-hash-table-pop*
dict-map-id t125-hash-table-map*
dict-filter-id t125-hash-table-filter*
dict-remove-id t125-hash-table-remove*
dict-alter-id t125-hash-table-alter*
dict-size-id t125-hash-table-size*
dict-for-each-id t125-hash-table-for-each*
dict-keys-id t125-hash-table-keys*
dict-values-id t125-hash-table-values*
dict-entries-id t125-hash-table-entries*
dict-fold-id t125-hash-table-fold*
dict-map->list-id t125-hash-table-map->list*
dict->alist-id t125-hash-table->alist*
dict-comparator-id t125-hash-table-comparator*)))
|
