diff options
| author | 2022-07-14 19:26:33 -0400 | |
|---|---|---|
| committer | 2022-07-14 19:26:33 -0400 | |
| commit | 85689befa282c43e97da86943ad25b95eba130d4 (patch) | |
| tree | 7e7104fb5dade35484d104d637d5d552c830cc6d /srfi/externals.scm | |
| parent | return of alists (diff) | |
| parent | Merge pull request #4 from arvyy/master (diff) | |
Merge branch 'master' of https://github.com/johnwcowan/srfi-225
Diffstat (limited to 'srfi/externals.scm')
| -rw-r--r-- | srfi/externals.scm | 76 |
1 files changed, 14 insertions, 62 deletions
diff --git a/srfi/externals.scm b/srfi/externals.scm index d08f4a4..f1045e5 100644 --- a/srfi/externals.scm +++ b/srfi/externals.scm @@ -26,38 +26,6 @@ (assume (dto? dto)) (apply (dto-ref-stx dto index) dto args))))) -;; define mutable and immutable versions of a procedure (such as dict-set! and dict-set) -;; with appropriate assertion for dict-mutable? value -;; when dto is first arg, and dict is second arg -(define-syntax define/dict-proc-pair - (syntax-rules () - ((_ proc-immutable proc-mutable index) - (begin - (define (proc-mutable dto dict . args) - (assume (dto? dto)) - (assume (not ((dto-ref-stx dto dict-pure?-id) dto dict)) index) - (apply (dto-ref-stx dto index) dto dict args)) - (define (proc-immutable dto dict . args) - (assume (dto? dto)) - (assume ((dto-ref-stx dto dict-pure?-id) dto dict) index) - (apply (dto-ref-stx dto index) dto dict args)))))) - -;; define mutable and immutable versions of a procedure (such as dict-set! and dict-set) -;; with appropriate assertion for dict-mutable? value -;; when dto is first arg, and dict is third arg (ie filter, map shape signature) -(define-syntax define/dict-proc-pair* - (syntax-rules () - ((_ proc-immutable proc-mutable index) - (begin - (define (proc-mutable dto proc dict) - (assume (dto? dto)) - (assume (not ((dto-ref-stx dto dict-pure?-id) dto dict)) index) - ((dto-ref-stx dto index) dto proc dict)) - (define (proc-immutable dto proc dict) - (assume (dto? dto)) - (assume ((dto-ref-stx dto dict-pure?-id) dto dict) index) - ((dto-ref-stx dto index) dto proc dict)))))) - (define/dict-proc dictionary? dictionary?-id) (define/dict-proc dict-empty? dict-empty?-id) (define/dict-proc dict-contains? dict-contains?-id) @@ -79,12 +47,12 @@ ((dto-ref-stx dto dict-ref-id) dto dict key failure success)))) (define/dict-proc dict-ref/default dict-ref/default-id) -(define/dict-proc-pair dict-set dict-set! dict-set-id) -(define/dict-proc-pair dict-adjoin dict-adjoin! dict-adjoin-id) -(define/dict-proc-pair dict-delete dict-delete! dict-delete-id) -(define/dict-proc-pair dict-delete-all dict-delete-all! dict-delete-all-id) -(define/dict-proc-pair dict-replace dict-replace! dict-replace-id) -(define/dict-proc-pair dict-intern dict-intern! dict-intern-id) +(define/dict-proc dict-set dict-set-id) +(define/dict-proc dict-adjoin dict-adjoin-id) +(define/dict-proc dict-delete dict-delete-id) +(define/dict-proc dict-delete-all dict-delete-all-id) +(define/dict-proc dict-replace dict-replace-id) +(define/dict-proc dict-intern dict-intern-id) (define dict-update (case-lambda @@ -98,30 +66,14 @@ ((dto dict key updater failure success) (assume (dto? dto)) - (assume ((dto-ref-stx dto dict-pure?-id) dto dict)) - ((dto-ref-stx dto dict-update-id) dto dict key updater failure success)))) - -(define dict-update! - (case-lambda - ((dto dict key updater) - (dict-update dto dict key updater - (lambda () (error "Key not found in dictionary" dict key)) - values)) - - ((dto dict key updater failure) - (dict-update dto dict key updater failure values)) - - ((dto dict key updater failure success) - (assume (dto? dto)) - (assume (not ((dto-ref-stx dto dict-pure?-id) dto dict))) ((dto-ref-stx dto dict-update-id) dto dict key updater failure success)))) -(define/dict-proc-pair dict-update/default dict-update/default! dict-update/default-id) -(define/dict-proc-pair dict-pop dict-pop! dict-pop-id) -(define/dict-proc-pair* dict-map dict-map! dict-map-id) -(define/dict-proc-pair* dict-filter dict-filter! dict-filter-id) -(define/dict-proc-pair* dict-remove dict-remove! dict-remove-id) -(define/dict-proc-pair dict-find-update dict-find-update! dict-find-update-id) +(define/dict-proc dict-update/default dict-update/default-id) +(define/dict-proc dict-pop dict-pop-id) +(define/dict-proc dict-map dict-map-id) +(define/dict-proc dict-filter dict-filter-id) +(define/dict-proc dict-remove dict-remove-id) +(define/dict-proc dict-find-update dict-find-update-id) (define/dict-proc dict-size dict-size-id) (define/dict-proc dict-count dict-count-id) (define/dict-proc dict-any dict-any-id) @@ -146,8 +98,8 @@ ((dto dict start) (dict->generator dto dict start #f)) ((dto dict start end) ((dto-ref-stx dto dict->generator-id) dto dict start end)))) -(define/dict-proc-pair dict-set-accumulator dict-set!-accumulator dict-set-accumulator-id) -(define/dict-proc-pair dict-adjoin-accumulator dict-adjoin!-accumulator dict-adjoin-accumulator-id) +(define/dict-proc dict-set-accumulator dict-set-accumulator-id) +(define/dict-proc dict-adjoin-accumulator dict-adjoin-accumulator-id) (define (dto-ref dto procindex) (dto-ref-stx dto procindex)) |
