blob: 4151dbae6bde1b23aa43cb71d123aeb3dba38595 (
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
|
(define srfi-69-dtd
(let ()
(define (prep-dtd-arg proc)
(lambda (dtd . args)
(apply proc args)))
(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-comparator* dtd table)
(make-comparator (lambda args #t)
(or (t69:hash-table-equivalence-function table)
equal?)
#f
(t69:hash-table-hash-function table)))
(make-dtd
make-dictionary-index t69:make-hash-table*
dictionary?-index (prep-dtd-arg t69:hash-table?)
dict-ref-index t69:hash-table-ref*
dict-ref/default-index (prep-dtd-arg t69:hash-table-ref/default)
dict-set!-index t69:hash-table-set!*
dict-delete-all!-index t69:hash-table-delete-all!*
dict-contains?-index (prep-dtd-arg t69:hash-table-exists?)
dict-update/default!-index t69:hash-table-update!/default*
dict-size-index (prep-dtd-arg t69:hash-table-size)
dict-keys-index (prep-dtd-arg t69:hash-table-keys)
dict-values-index (prep-dtd-arg 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 (prep-dtd-arg 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 (prep-dtd-arg t69:hash-table-copy))))
|
