diff options
| author |  Arvydas Silanskas
| 2021-10-17 12:09:08 +0300 |
|---|---|---|
| committer | Arvydas Silanskas
| 2021-10-17 12:09:08 +0300 |
| commit | 1e501c16b620c976a9b2d85ba5ad82b5e83ae0da (patch) | |
| tree | 000f4e1c767113245478e5485f2bf4cc05a6d3e0 /srfi/srfi-146-impl.scm | |
| parent | work (diff) | |
work
Diffstat (limited to '')
| -rw-r--r-- | srfi/srfi-146-impl.scm | 45 |
1 files changed, 30 insertions, 15 deletions
diff --git a/srfi/srfi-146-impl.scm b/srfi/srfi-146-impl.scm index 7d36dc8..49b4737 100644 --- a/srfi/srfi-146-impl.scm +++ b/srfi/srfi-146-impl.scm @@ -4,39 +4,54 @@ (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 - make-dictionary-id (prep-dtd-arg mapping) 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-set!-id (prep-dtd-arg mapping-set!) dict-adjoin-id (prep-dtd-arg mapping-adjoin) - dict-adjoin!-id (prep-dtd-arg mapping-adjoin!) dict-delete-id (prep-dtd-arg mapping-delete) - dict-delete!-id (prep-dtd-arg mapping-delete!) dict-delete-all-id (prep-dtd-arg mapping-delete-all) - dict-delete-all!-id (prep-dtd-arg mapping-delete-all!) dict-replace-id (prep-dtd-arg mapping-replace) - dict-replace!-id (prep-dtd-arg mapping-replace!) dict-intern-id (prep-dtd-arg mapping-intern) - dict-intern!-id (prep-dtd-arg mapping-intern!) dict-update-id (prep-dtd-arg mapping-update) - dict-update!-id (prep-dtd-arg mapping-update!) dict-update/default-id (prep-dtd-arg mapping-update/default) - dict-update/default!-id (prep-dtd-arg mapping-update!/default) dict-pop-id (prep-dtd-arg mapping-pop) - dict-pop!-id (prep-dtd-arg mapping-pop!) dict-filter-id (prep-dtd-arg mapping-filter) - dict-filter!-id (prep-dtd-arg mapping-filter!) dict-remove-id (prep-dtd-arg mapping-remove) - dict-remove!-id (prep-dtd-arg mapping-remove!) - dict-search-id (prep-dtd-arg mapping-search) - dict-search!-id (prep-dtd-arg mapping-search!) - dict-copy-id (prep-dtd-arg mapping-copy) + 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) |