blob: 095a57ae4e2f04a47e771c46dd5e63b814cb52a7 (
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
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
|
;;;; Internal procedure definitions (all take a vec argument first)
;;; Sample call of an internal procedure from another internal procedure:
;;; (dcall dref/default vec dictionary key default)
;;; Notes on definitions:
;;; Vec argument is not used except to pass to dcalls
;;; External procedures with a rest argument use a list argument here
;;; External procedures with optional arguments are not optional here
(define-syntax dcall
(syntax-rules ()
((dcall dproc vec dictionary arg ...)
((vector-ref vec dproc) vec dictionary arg ...))))
(define (idictionary? vec obj)
(error "dictionary? method not defined"))
(define (idict-empty? vec dictionary)
(= 0 (dcall dsize vec dictionary)))
(define (idict-contains? vec dictionary key)
(dcall dref vec dictionary key
(lambda () #f) (lambda (x) #t)))
(define (idict-ref vec dictionary key failure success)
(define-values
(new-dict result)
(dcall dsearch! vec dictionary key
(lambda (_ ignore)
(ignore (failure)))
(lambda (key value update _)
(update key value (success value)))))
result)
(define (idict-ref/default vec dictionary key default)
(dcall dref vec dictionary key
(lambda () default)
(lambda (x) x)))
;; private
(define (idict-set!* vec dictionary use-old? objs)
(let loop ((objs objs)
(dictionary dictionary))
(cond
((null? objs)
dictionary)
((null? (cdr objs))
(error "mismatch of key / values argument list" objs))
(else (let*-values
(((key) (car objs))
((value) (cadr objs))
((new-d _) (dcall dsearch! vec dictionary key
(lambda (insert ignore)
(insert value #f))
(lambda (key old-value update delete)
(update key (if use-old? old-value value) #f)))))
(loop (cddr objs)
new-d))))))
(define (idict-set! vec dictionary objs)
(idict-set!* vec dictionary #f objs))
(define (idict-adjoin! vec dictionary objs)
(idict-set!* vec dictionary #t objs))
(define (idict-delete! vec dictionary keys)
(dcall ddelete-all! vec dictionary keys))
(define (idict-delete-all! vec dictionary keylist)
(let loop ((keylist keylist)
(dictionary dictionary))
(cond
((null? keylist) dictionary)
(else (let*-values
(((key) (car keylist))
((new-d _) (dcall dsearch! vec dictionary key
(lambda (_ ignore)
(ignore #f))
(lambda (key old-value _ delete)
(delete #f)))))
(loop (cdr keylist)
new-d))))))
(define (idict-replace! vec dictionary key value)
(define-values
(new-dict _)
(dcall dsearch! vec dictionary key
(lambda (_ ignore)
(ignore #f))
(lambda (key old-value update _)
(update key value #f))))
new-dict)
(define (idict-intern! vec dictionary key failure)
(dcall dsearch! vec dictionary key
(lambda (insert _)
(let ((value (failure)))
(insert value value)))
(lambda (key value update _)
(update key value value))))
(define (idict-update! vec dictionary key updater failure success)
(define-values
(new-dict _)
(dcall dsearch! vec dictionary key
(lambda (insert ignore)
(insert (updater (failure)) #f))
(lambda (key value update _)
(update key (updater (success value)) #f))))
new-dict)
(define (idict-update/default! vec dictionary key updater default)
(dcall dupdate! vec dictionary key updater
(lambda () default)
(lambda (x) x)))
(define (idict-pop! vec dictionary)
(define (do-pop)
(call/cc
(lambda (cont)
(dcall dfor-each vec
(lambda (key value)
(define new-dict
(dcall ddelete! vec dictionary (list key)))
(cont new-dict key value))
dictionary))))
(define empty? (dcall dempty? vec dictionary))
(if empty?
(error "popped empty dictionary")
(do-pop)))
(define (idict-map! vec proc dictionary)
(error "dict-map method not defined"))
(define (idict-filter! vec pred dictionary)
(error "dict-filter! method not defined"))
(define (idict-remove! vec pred dictionary)
(dcall dfilter! vec (lambda (key value) (not (pred key value))) dictionary))
(define (idict-search! vec dictionary key failure success)
(error "dict-search! method not defined"))
(define (idict-size vec dictionary)
(error "dict-size method not defined"))
(define (idict-for-each vec proc dictionary)
(error "dict-for-each method not defined"))
(define (idict-count vec pred dictionary)
(dcall dfold vec
(lambda (key value acc)
(if (pred key value)
(+ 1 acc)
acc))
0
dictionary))
(define (idict-any vec pred dictionary)
(call/cc
(lambda (cont)
(dcall dfor-each vec
(lambda (key value)
(define ret (pred key value))
(when ret
(cont ret)))
dictionary)
#f)))
(define (idict-every vec pred dictionary)
(define last #t)
(call/cc
(lambda (cont)
(dcall dfor-each vec
(lambda (key value)
(define ret (pred key value))
(when (not ret)
(cont #f))
(set! last ret))
dictionary)
last)))
(define (idict-keys vec dictionary)
(reverse
(dcall dfold vec
(lambda (key value acc)
(cons key acc))
'()
dictionary)))
(define (idict-values vec dictionary)
(reverse
(dcall dfold vec
(lambda (key value acc)
(cons value acc))
'()
dictionary)))
(define (idict-entries vec dictionary)
(define pair
(dcall dfold vec
(lambda (key value acc)
(cons (cons key (car acc))
(cons value (cdr acc))))
(cons '() '())
dictionary))
(values (reverse (car pair))
(reverse (cdr pair))))
(define (idict-fold vec proc knil dictionary)
(define acc knil)
(dcall dfor-each vec
(lambda (key value)
(set! acc (proc key value acc)))
dictionary)
acc)
(define (idict-map->list vec proc dictionary)
(define reverse-lst
(dcall dfold vec
(lambda (key value lst)
(cons (proc key value) lst))
'()
dictionary))
(reverse reverse-lst))
(define (idict->alist vec dictionary)
(dcall dmap->list vec
cons
dictionary))
(define model-vec
(vector
idictionary? idict-empty? idict-contains? idict-ref
idict-ref/default idict-set! idict-adjoin! idict-delete!
idict-delete-all! idict-replace! idict-intern!
idict-update! idict-update/default! idict-pop! idict-map!
idict-filter! idict-remove! idict-search! idict-size
idict-for-each idict-count idict-any idict-every idict-keys
idict-values idict-entries idict-fold idict-map->list
idict->alist))
|
