blob: b3affe49129902d3f547285add5d4be315fd62ef (
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
|
(define hash-table-dto
(let ()
(define (t125-hash-table-pure?* dto table)
#f)
(define (t125-hash-table-set* dto table . obj)
(apply t125-hash-table-set! (cons table obj))
table)
(define (t125-hash-table-update* dto table key updater fail success)
(t125-hash-table-update! table key updater fail success)
table)
(define (t125-hash-table-update/default* dto table key proc default)
(t125-hash-table-update!/default table key proc default)
table)
(define (t125-hash-table-intern* dto table key failure)
(values table (t125-hash-table-intern! table key failure)))
(define (t125-hash-table-pop* dto table)
(if (t125-hash-table-empty? table)
(error "popped empty dictionary")
(call-with-values (lambda () (t125-hash-table-pop! table))
(lambda (key value) (values table key value)))))
(define (t125-hash-table-delete-all* dto table keys)
(for-each
(lambda (key)
(t125-hash-table-delete! table key))
keys)
table)
(define (t125-hash-table-map* dto proc table)
(t125-hash-table-map! proc table))
(define (t125-hash-table-filter* dto proc table)
(t125-hash-table-prune!
(lambda (key value)
(not (proc key value)))
table)
table)
(define (t125-hash-table-remove* dto proc table)
(t125-hash-table-prune! proc table)
table)
(define (t125-hash-table-find-update* dto table key fail success)
;; instead of running immediately,
;; add an indirection through thunk
;; to guarantee call in tail position
(define (make-success-thunk value)
(define (update new-key new-value)
(unless (eq? new-key key)
(t125-hash-table-delete! table key))
(t125-hash-table-set! table new-key new-value)
table)
(define (remove)
(t125-hash-table-delete! table key)
table)
(lambda ()
(success key value update remove) ))
(define (make-failure-thunk)
(define (ignore)
table)
(define (insert value)
(t125-hash-table-set! table key value)
table)
(lambda ()
(fail insert ignore)))
(define thunk (t125-hash-table-ref table key make-failure-thunk make-success-thunk))
(thunk))
(define (t125-hash-table-comparator* dto table)
(make-comparator (lambda args #t)
(t125-hash-table-equivalence-function table)
#f
(t125-hash-table-hash-function table)))
(define (t125-hash-table-copy* dto table)
(t125-hash-table-copy table #t))
(define (t125-hash-table-size* dto table)
(t125-hash-table-size table))
(define (t125-hash-table-keys* dto table)
(t125-hash-table-keys table))
(define (t125-hash-table-values* dto table)
(t125-hash-table-values table))
(define (t125-hash-table-entries* dto table)
(t125-hash-table-entries table))
(define (t125-hash-table-fold* dto proc knil table)
(t125-hash-table-fold proc knil table))
(define (t125-hash-table-map->list* dto proc table)
(t125-hash-table-map->list proc table))
(define (t125-hash-table->alist* dto table)
(t125-hash-table->alist table))
(define (t125-hash-table?* dto table)
(t125-hash-table? table))
(define (t125-hash-table-empty?* dto table)
(t125-hash-table-empty? table))
(define (t125-hash-table-contains?* dto table key)
(t125-hash-table-contains? table key))
(define (t125-hash-table-ref* dto table key failure success)
(t125-hash-table-ref table key failure success))
(define (t125-hash-table-ref/default* dto table key default)
(t125-hash-table-ref/default table key default))
(make-dto
dictionary?-id t125-hash-table?*
dict-pure?-id t125-hash-table-pure?*
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-find-update-id t125-hash-table-find-update*
dict-size-id t125-hash-table-size*
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*)))
|
