blob: e2b2a296897f6079c14381c421684dbc2a703696 (
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 (make-alist-dtd key=)
(define (alist? dtd l)
(and (list? l)
(or (null? l)
(pair? (car l)))))
(define (alist-mutable? dtd alist)
#f)
(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-delete dtd key alist)
(filter
(lambda (entry)
(not (key= (car entry) key)))
alist))
(define (alist-alter dtd alist key failure success)
(define (handle-success pair)
(define old-key (car pair))
(define old-value (cdr pair))
(define (update new-key new-value)
(cond
((and (eq? old-key
new-key)
(eq? old-value
new-value))
alist)
(else
(let ((new-list
(alist-cons
new-key new-value
(alist-delete dtd old-key alist))))
new-list))))
(define (remove)
(alist-delete dtd old-key alist))
(success old-key old-value update remove))
(define (handle-failure)
(define (insert value)
(alist-cons key value alist))
(define (ignore)
alist)
(failure insert ignore))
(cond
((assoc key alist key=) => handle-success)
(else (handle-failure))))
(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->alist dtd alist)
alist)
(define (alist-comparator dtd dictionary)
#f)
(make-dtd
dictionary?-id alist?
dict-mutable?-id alist-mutable?
dict-map-id alist-map
dict-filter-id alist-filter
dict-alter-id alist-alter
dict-size-id alist-size
dict-for-each-id alist-foreach
dict->alist-id alist->alist
dict-comparator-id alist-comparator))
(define alist-eqv-dtd (make-alist-dtd eqv?))
(define alist-equal-dtd (make-alist-dtd equal?))
|
