blob: 49b47370a2978a9b2113321f6ef5df14ac8b26b0 (
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
|
(define mapping-dtd
(let ()
(define (prep-dtd-arg proc)
(lambda (dtd . args)
(apply proc args)))
(define (mapping-alter* dtd dict key failure success)
(call/cc
;; escape from whole hashmap-search entirely, when success / failure
;; return something other than through passed in continuation procedures
(lambda (k)
(define-values
(new-dict ignored)
(mapping-search dict key
(lambda (insert ignore)
;; handle when continuation procedure is called
;; and force it into tail call
(call/cc (lambda (k2)
(define result
(failure (lambda (value) (k2 (insert value #f)))
(lambda () (k2 (ignore #f)))))
;; neither insert nor ignore called -- return result to top level escape
(k result))))
(lambda (key value update remove)
(call/cc (lambda (k2)
(define result
(success
key
value
(lambda (new-key new-value) (k2 (update new-key new-value #f)))
(lambda () (k2 (remove #f)))))
(k result))))))
new-dict)))
(make-dtd
dictionary?-id (prep-dtd-arg mapping?)
dict-mutable?-id (lambda _ #f)
dict-empty?-id (prep-dtd-arg mapping-empty?)
dict-contains?-id (prep-dtd-arg mapping-contains?)
dict-ref-id (prep-dtd-arg mapping-ref)
dict-ref/default-id (prep-dtd-arg mapping-ref/default)
dict-set-id (prep-dtd-arg mapping-set)
dict-adjoin-id (prep-dtd-arg mapping-adjoin)
dict-delete-id (prep-dtd-arg mapping-delete)
dict-delete-all-id (prep-dtd-arg mapping-delete-all)
dict-replace-id (prep-dtd-arg mapping-replace)
dict-intern-id (prep-dtd-arg mapping-intern)
dict-update-id (prep-dtd-arg mapping-update)
dict-update/default-id (prep-dtd-arg mapping-update/default)
dict-pop-id (prep-dtd-arg mapping-pop)
dict-filter-id (prep-dtd-arg mapping-filter)
dict-remove-id (prep-dtd-arg mapping-remove)
dict-alter-id mapping-alter*
dict-size-id (prep-dtd-arg mapping-size)
dict-for-each-id (prep-dtd-arg mapping-for-each)
dict-count-id (prep-dtd-arg mapping-count)
dict-keys-id (prep-dtd-arg mapping-keys)
dict-values-id (prep-dtd-arg mapping-values)
dict-entries-id (prep-dtd-arg mapping-entries)
dict-fold-id (prep-dtd-arg mapping-fold)
dict-map->list-id (prep-dtd-arg mapping-map->list)
dict->alist-id (prep-dtd-arg mapping->alist)
dict-comparator-id (prep-dtd-arg mapping-key-comparator))))
|
