blob: 8fee936e7411b3a7442b0f6d28c419b65f7dd473 (
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
131
132
133
134
135
136
137
138
139
140
|
;; procedure definitions that don't rely on concrete implementations
(define-record-type <dtd>
(make-dtd-private procvec)
dtd?
(procvec procvec))
(define-record-type <dtd-err>
(make-dictionary-error message irritants)
dictionary-error?
(message dictionary-message)
(irritants dictionary-irritants))
(define-syntax define/dict-proc
(syntax-rules ()
((_ proc index)
(define (proc dtd . args)
(assume (dtd? dtd))
(apply (vector-ref (procvec dtd) index) dtd args)))))
(define/dict-proc make-dictionary make-dictionary-index)
(define/dict-proc dictionary? dictionary?-index)
(define/dict-proc dict-empty? dict-empty?-index)
(define/dict-proc dict-contains? dict-contains?-index)
(define dict-ref
(case-lambda
((dtd dict key)
(dict-ref dtd dict key
(lambda () (error "Key not found in dictionary" dict key))
values))
((dtd dict key failure)
(dict-ref dtd dict key failure values))
((dtd dict key failure success)
(assume (dtd? dtd))
((vector-ref (procvec dtd) dict-ref-index) dtd dict key failure success))))
(define/dict-proc dict-ref/default dict-ref/default-index)
(define/dict-proc dict-set dict-set-index)
(define/dict-proc dict-set! dict-set!-index)
(define/dict-proc dict-adjoin dict-adjoin-index)
(define/dict-proc dict-adjoin! dict-adjoin!-index)
(define/dict-proc dict-delete dict-delete-index)
(define/dict-proc dict-delete! dict-delete!-index)
(define/dict-proc dict-delete-all dict-delete-all-index)
(define/dict-proc dict-delete-all! dict-delete-all!-index)
(define/dict-proc dict-replace dict-replace-index)
(define/dict-proc dict-replace! dict-replace!-index)
(define/dict-proc dict-intern dict-intern-index)
(define/dict-proc dict-intern! dict-intern!-index)
(define dict-update
(case-lambda
((dtd dict key updater)
(dict-update dtd dict key updater
(lambda () (error "Key not found in dictionary" dict key))
values))
((dtd dict key updater failure)
(dict-update dtd dict key updater failure values))
((dtd dict key updater failure success)
(assume (dtd? dtd))
((vector-ref (procvec dtd) dict-update-index) dtd dict key updater failure success))))
(define dict-update!
(case-lambda
((dtd dict key updater)
(dict-update! dtd dict key updater
(lambda () (error "Key not found in dictionary" dict key))
values))
((dtd dict key updater failure)
(dict-update! dtd dict key updater failure values))
((dtd dict key updater failure success)
(assume (dtd? dtd))
((vector-ref (procvec dtd) dict-update!-index) dtd dict key updater failure success))))
(define/dict-proc dict-update/default dict-update/default-index)
(define/dict-proc dict-update/default! dict-update/default!-index)
(define/dict-proc dict-pop dict-pop-index)
(define/dict-proc dict-pop! dict-pop!-index)
(define/dict-proc dict-map dict-map-index)
(define/dict-proc dict-map! dict-map!-index)
(define/dict-proc dict-filter dict-filter-index)
(define/dict-proc dict-filter! dict-filter!-index)
(define/dict-proc dict-remove dict-remove-index)
(define/dict-proc dict-remove! dict-remove!-index)
(define/dict-proc dict-search dict-search-index)
(define/dict-proc dict-search! dict-search!-index)
(define/dict-proc dict-copy dict-copy-index)
(define/dict-proc dict-size dict-size-index)
(define/dict-proc dict-for-each dict-for-each-index)
(define/dict-proc dict-count dict-count-index)
(define/dict-proc dict-any dict-any-index)
(define/dict-proc dict-every dict-every-index)
(define/dict-proc dict-keys dict-keys-index)
(define/dict-proc dict-values dict-values-index)
(define/dict-proc dict-entries dict-entries-index)
(define/dict-proc dict-fold dict-fold-index)
(define/dict-proc dict-map->list dict-map->list-index)
(define/dict-proc dict->alist dict->alist-index)
(define/dict-proc dict-comparator dict-comparator-index)
(define (dtd-ref dtd procindex)
(vector-ref (procvec dtd) procindex))
(define (make-modified-dtd dtd . lst)
(define vec (vector-copy (procvec dtd)))
(do ((lst lst (cddr lst)))
((null? lst))
(when (null? (cdr lst))
(error "Uneven amount of arguments" lst))
(let ((proc-index (car lst))
(proc (cadr lst)))
(unless (procedure? proc)
(error "Not a procedure" proc))
(vector-set! vec proc-index proc)))
(make-dtd-private vec))
(define (make-dtd . lst)
(apply make-modified-dtd default-dtd lst))
(define-syntax dtd-helper
(syntax-rules ()
((_ (arg ...) (index proc) rest ...)
(dtd-helper (arg ... index proc) rest ...))
((_ (arg ...))
(make-dtd arg ...))))
(define-syntax dtd
(syntax-rules ()
((_ (index proc) ...)
(dtd-helper () (index proc) ...))))
(define (dictionary-error message . irritants)
(make-dictionary-error message irritants))
|
