blob: a77d74f9bb4cd9fa196572a879e9b28debdfe403 (
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
|
(define (make-alist-impl)
(define (alist? vec l)
(and (list? l) (every pair? l)))
(define (alist-map! vec proc alist)
(map
(lambda (e)
(define key (car e))
(define value (cdr e))
(cons key (proc key value)))
alist))
(define (alist-filter! vec pred alist)
(filter
(lambda (e)
(pred (car e) (cdr e)))
alist))
(define (alist-search! vec 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 old-key alist))))
(values new-list obj)))))
(define (remove obj)
(values (alist-delete 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) => handle-success)
(else (handle-failure))))
(define (alist-size vec alist)
(define keys (map car alist))
(define (fold-proc el set)
(lset-adjoin equal? set el))
(define key-set (fold fold-proc '() keys))
(length key-set))
(define (alist-foreach vec proc alist)
(define (proc* e)
(proc (car e) (cdr e)))
(for-each proc* alist))
(define (alist->alist vec alist)
alist)
(define vec (vector-copy model-vec))
(vector-set! vec d? alist?)
(vector-set! vec dmap! alist-map!)
(vector-set! vec dfilter! alist-filter!)
(vector-set! vec dsearch! alist-search!)
(vector-set! vec dsize alist-size)
(vector-set! vec dfor-each alist-foreach)
(vector-set! vec d->alist alist->alist)
vec)
|
