blob: e64dc97ce1992cba8ab31ecdca2aade9fedeceb2 (
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
|
(define (make-alist-dtd key=)
(define (make-alist dtd comparator)
(when comparator
(raise (dictionary-error "alist dtd doesn't accept comparator" dtd)))
'())
(define (alist? dtd l)
(and (list? l)
(or (null? l)
(pair? (car l)))))
(define (alist-map dtd proc alist)
(map
(lambda (e)
(define key (car e))
(define value (cdr e))
(cons key (proc key value)))
alist))
(define (alist-map! dtd proc alist)
(map!
(lambda (e)
(define key (car e))
(define value (cdr e))
(cons key (proc key value)))
alist))
(define (alist-filter dtd pred alist)
(filter
(lambda (e)
(pred (car e) (cdr e)))
alist))
(define (alist-filter! dtd pred alist)
(filter!
(lambda (e)
(pred (car e) (cdr e)))
alist))
(define (alist-delete dtd key alist)
(filter
(lambda (entry)
(not (key= (car entry) key)))
alist))
(define (alist-delete! dtd key alist)
(filter!
(lambda (entry)
(not (key= (car entry) key)))
alist))
(define (alist-search* dtd alist-delete-proc alist key failure success)
(define (handle-success pair)
(define old-key (car pair))
(define old-value (cdr pair))
(define (update new-key new-value obj)
(cond
((and (eq? old-key
new-key)
(eq? old-value
new-value))
(values alist obj))
(else
(let ((new-list
(alist-cons
new-key new-value
(alist-delete-proc dtd old-key alist))))
(values new-list obj)))))
(define (remove obj)
(values (alist-delete-proc dtd old-key alist) obj))
(success old-key old-value update remove))
(define (handle-failure)
(define (insert value obj)
(values (alist-cons key value alist)
obj))
(define (ignore obj)
(values alist obj))
(failure insert ignore))
(cond
((assoc key alist key=) => handle-success)
(else (handle-failure))))
(define (alist-search dtd alist key failure success)
(alist-search* dtd alist-delete alist key failure success))
(define (alist-search! dtd alist key failure success)
(alist-search* dtd alist-delete! alist key failure success))
(define (alist-size dtd alist)
(length alist))
(define (alist-foreach dtd proc alist)
(define (proc* e)
(proc (car e) (cdr e)))
(for-each proc* alist))
(define (alist-copy dtd alist)
(map
(lambda (e)
(cons (car e) (cdr e)))
alist))
(define (alist->alist dtd alist)
(alist-copy dtd alist))
(define (alist-comparator dtd dictionary)
(make-comparator (lambda args #t)
key=
#f
#f))
(make-dtd
make-dictionary-index make-alist
dictionary?-index alist?
dict-map-index alist-map
dict-map!-index alist-map!
dict-filter-index alist-filter
dict-filter!-index alist-filter!
dict-search-index alist-search
dict-search!-index alist-search!
dict-size-index alist-size
dict-for-each-index alist-foreach
dict->alist-index alist->alist
dict-comparator-index alist-comparator
dict-copy-index alist-copy))
(define alist-eqv-dtd (make-alist-dtd eqv?))
(define alist-equal-dtd (make-alist-dtd equal?))
|
