blob: 09f92d25beca56a613828b4853adbdf4e7d7dff7 (
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
|
(define (register-srfi-69!)
(define (hash-table-ref* table key fail success)
(define default (cons #f #f))
(define found (hash-table-ref/default table key default))
(if (eq? found default)
(fail)
(success found)))
(define (hash-table-set!* table . obj)
(let loop ((obj obj))
(if (null? obj)
table
(begin
(hash-table-set! table (car obj) (cadr obj))
(loop (cddr obj))))))
(define (hash-table-update!/default* table key proc default)
(hash-table-update!/default table key proc default)
table)
(define (hash-table-delete-all!* table keys)
(for-each
(lambda (key)
(hash-table-delete! table key))
keys)
table)
(define (hash-table-foreach* proc table)
(hash-table-walk table proc))
(define (hash-table-map* proc table)
(hash-table-walk table (lambda (key value)
(hash-table-set! table key (proc key value))))
table)
(define (hash-table-filter* proc table)
(hash-table-walk table
(lambda (key value)
(unless (proc key value)
(hash-table-delete! table key))))
table)
(define (hash-table-fold* proc knil table)
(hash-table-fold table proc knil))
(define (hash-table-search* table key fail success)
(define (handle-success value)
(define (update new-key new-value obj)
(unless (eq? new-key key)
(hash-table-delete! table key))
(hash-table-set! table new-key new-value)
(values table obj))
(define (remove obj)
(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)
(hash-table-set! table key value)
(values table obj))
(fail insert ignore))
(define default (cons #f #f))
(define found (hash-table-ref/default table key default))
(if (eq? default found)
(handle-fail)
(handle-success found)))
(register-dictionary!
'dictionary? hash-table?
'dict-ref hash-table-ref*
'dict-ref/default hash-table-ref/default
'dict-set! hash-table-set!*
'dict-delete-all! hash-table-delete-all!*
'dict-contains? hash-table-exists?
'dict-update/default! hash-table-update!/default*
'dict-size hash-table-size
'dict-keys hash-table-keys
'dict-values hash-table-values
'dict-map! hash-table-map*
'dict-filter! hash-table-filter*
'dict-for-each hash-table-foreach*
'dict-fold hash-table-fold*
'dict->alist hash-table->alist
'dict-search! hash-table-search*))
|
