blob: 4bdb53dd3c51a047a6b17b7fc30934b882b86d6f (
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
|
(define srfi-126-dto
(let ()
(define (prep-dto-arg proc)
(lambda (dto . args)
(apply proc args)))
(define (t126-hashtable-pure?* dto table)
#f)
(define (t126-hashtable-ref* dto table key fail success)
(define-values (value found?) (t126-hashtable-lookup table key))
(if found?
(success value)
(fail)))
(define (t126-hashtable-ref/default* dto table key default)
(t126-hashtable-ref table key default))
(define (t126-hashtable-set* dto table . obj)
(let loop ((obj obj))
(if (null? obj)
#t
(begin
(t126-hashtable-set! table (car obj) (cadr obj))
(loop (cddr obj)))))
table)
(define (t126-hashtable-delete-all* dto table keys)
(for-each
(lambda (key)
(t126-hashtable-delete! table key))
keys)
table)
(define (t126-hashtable-intern* dto table key default)
(values table (t126-hashtable-intern! table key default)))
(define (t126-hashtable-update/default* dto table key updater default)
(t126-hashtable-update! table key updater default)
table)
(define (t126-hashtable-pop* dto table)
(if (t126-hashtable-empty? table)
(error "popped empty dictionary")
(call-with-values (lambda () (t126-hashtable-pop! table))
(lambda (key value) (values table key value)))))
(define (t126-hashtable-update-all* dto proc table)
(t126-hashtable-update-all! table proc)
table)
(define (t126-hashtable-filter* dto proc table)
(t126-hashtable-prune! table
(lambda (key value)
(not (proc key value))))
table)
(define (t126-hashtable-remove* dto proc table)
(t126-hashtable-prune! table proc)
table)
(define (t126-hashtable-find-update* dto table key fail success)
(define (handle-success value)
(define (update new-key new-value)
(unless (eq? new-key key)
(t126-hashtable-delete! table key))
(t126-hashtable-set! table new-key new-value)
table)
(define (remove)
(t126-hashtable-delete! table key)
table)
(success key value update remove))
(define (handle-fail)
(define (ignore)
table)
(define (insert value)
(t126-hashtable-set! table key value)
table)
(fail insert ignore))
(define default (cons #f #f))
(define found (t126-hashtable-ref table key default))
(if (eq? default found)
(handle-fail)
(handle-success found)))
(define (t126-hashtable-map->lset* dto proc table)
(t126-hashtable-map->lset table proc))
(define (t126-hashtable-keys* dto table)
(vector->list (t126-hashtable-keys table)))
(define (t126-hashtable-values* dto table)
(vector->list (t126-hashtable-values table)))
(define (t126-hashtable-entries* dto table)
(call-with-values
(lambda () (t126-hashtable-entries table))
(lambda (keys vals)
(values
(vector->list keys)
(vector->list vals)))))
(define (t126-hashtable-comparator* dto table)
#f)
(make-dto
dictionary?-id (prep-dto-arg t126-hashtable?)
dict-pure?-id t126-hashtable-pure?*
dict-empty?-id (prep-dto-arg t126-hashtable-empty?)
dict-contains?-id (prep-dto-arg t126-hashtable-contains?)
dict-ref-id t126-hashtable-ref*
dict-ref/default-id t126-hashtable-ref/default*
dict-set-id t126-hashtable-set*
dict-delete-all-id t126-hashtable-delete-all*
dict-intern-id t126-hashtable-intern*
dict-update/default-id t126-hashtable-update/default*
dict-pop-id t126-hashtable-pop*
dict-map-id t126-hashtable-update-all*
dict-filter-id t126-hashtable-filter*
dict-remove-id t126-hashtable-remove*
dict-find-update-id t126-hashtable-find-update*
dict-size-id (prep-dto-arg t126-hashtable-size)
dict-keys-id t126-hashtable-keys*
dict-values-id t126-hashtable-values*
dict-entries-id t126-hashtable-entries*
dict-map->list-id t126-hashtable-map->lset*
dict-comparator-id t126-hashtable-comparator*)))
|
