diff options
| author | 2022-08-06 11:35:06 +0300 | |
|---|---|---|
| committer | 2022-08-06 11:35:06 +0300 | |
| commit | fd4585b6e0ac67ae9591a4183fb7c82ed3a30218 (patch) | |
| tree | 8da6ad7744c6b26cbcf3acdd7d08e83c33c5e014 /srfi/225/srfi-126-impl.sld | |
| parent | Merge branch 'master' of https://github.com/johnwcowan/srfi-225 (diff) | |
return alists; refactor structure
Diffstat (limited to '')
| -rw-r--r-- | srfi/225/srfi-126-impl.sld (renamed from srfi/srfi-126-impl.scm) | 100 |
1 files changed, 53 insertions, 47 deletions
diff --git a/srfi/srfi-126-impl.scm b/srfi/225/srfi-126-impl.sld index 4bdb53d..5acc2cc 100644 --- a/srfi/srfi-126-impl.scm +++ b/srfi/225/srfi-126-impl.sld @@ -1,36 +1,41 @@ -(define srfi-126-dto - (let () - +(define-library + (srfi 225 srfi-126-impl) + (import (scheme base) + (prefix (srfi 126) t126-) + (srfi 225 default-impl) + (srfi 225 indexes)) + (export srfi-126-dto) + (begin (define (prep-dto-arg proc) (lambda (dto . args) (apply proc args))) - + (define (t126-hashtable-pure?* dto table) #f) (define (t126-hashtable-ref* dto table key fail success) (define-values (value found?) (t126-hashtable-lookup table key)) (if found? - (success value) - (fail))) + (success value) + (fail))) (define (t126-hashtable-ref/default* dto table key default) (t126-hashtable-ref table key default)) (define (t126-hashtable-set* dto table . obj) (let loop ((obj obj)) - (if (null? obj) - #t - (begin - (t126-hashtable-set! table (car obj) (cadr obj)) - (loop (cddr obj))))) + (if (null? obj) + #t + (begin + (t126-hashtable-set! table (car obj) (cadr obj)) + (loop (cddr obj))))) table) (define (t126-hashtable-delete-all* dto table keys) (for-each - (lambda (key) - (t126-hashtable-delete! table key)) - keys) + (lambda (key) + (t126-hashtable-delete! table key)) + keys) table) (define (t126-hashtable-intern* dto table key default) @@ -42,9 +47,9 @@ (define (t126-hashtable-pop* dto table) (if (t126-hashtable-empty? table) - (error "popped empty dictionary") - (call-with-values (lambda () (t126-hashtable-pop! table)) - (lambda (key value) (values table key value))))) + (error "popped empty dictionary") + (call-with-values (lambda () (t126-hashtable-pop! table)) + (lambda (key value) (values table key value))))) (define (t126-hashtable-update-all* dto proc table) (t126-hashtable-update-all! table proc) @@ -52,8 +57,8 @@ (define (t126-hashtable-filter* dto proc table) (t126-hashtable-prune! table - (lambda (key value) - (not (proc key value)))) + (lambda (key value) + (not (proc key value)))) table) (define (t126-hashtable-remove* dto proc table) @@ -64,7 +69,7 @@ (define (handle-success value) (define (update new-key new-value) (unless (eq? new-key key) - (t126-hashtable-delete! table key)) + (t126-hashtable-delete! table key)) (t126-hashtable-set! table new-key new-value) table) (define (remove) @@ -82,8 +87,8 @@ (define default (cons #f #f)) (define found (t126-hashtable-ref table key default)) (if (eq? default found) - (handle-fail) - (handle-success found))) + (handle-fail) + (handle-success found))) (define (t126-hashtable-map->lset* dto proc table) (t126-hashtable-map->lset table proc)) @@ -96,34 +101,35 @@ (define (t126-hashtable-entries* dto table) (call-with-values - (lambda () (t126-hashtable-entries table)) + (lambda () (t126-hashtable-entries table)) (lambda (keys vals) (values - (vector->list keys) - (vector->list vals))))) + (vector->list keys) + (vector->list vals))))) (define (t126-hashtable-comparator* dto table) #f) - (make-dto - dictionary?-id (prep-dto-arg t126-hashtable?) - dict-pure?-id t126-hashtable-pure?* - dict-empty?-id (prep-dto-arg t126-hashtable-empty?) - dict-contains?-id (prep-dto-arg t126-hashtable-contains?) - dict-ref-id t126-hashtable-ref* - dict-ref/default-id t126-hashtable-ref/default* - dict-set-id t126-hashtable-set* - dict-delete-all-id t126-hashtable-delete-all* - dict-intern-id t126-hashtable-intern* - dict-update/default-id t126-hashtable-update/default* - dict-pop-id t126-hashtable-pop* - dict-map-id t126-hashtable-update-all* - dict-filter-id t126-hashtable-filter* - dict-remove-id t126-hashtable-remove* - dict-find-update-id t126-hashtable-find-update* - dict-size-id (prep-dto-arg t126-hashtable-size) - dict-keys-id t126-hashtable-keys* - dict-values-id t126-hashtable-values* - dict-entries-id t126-hashtable-entries* - dict-map->list-id t126-hashtable-map->lset* - dict-comparator-id t126-hashtable-comparator*))) + (define srfi-126-dto + (make-dto + dictionary?-id (prep-dto-arg t126-hashtable?) + dict-pure?-id t126-hashtable-pure?* + dict-empty?-id (prep-dto-arg t126-hashtable-empty?) + dict-contains?-id (prep-dto-arg t126-hashtable-contains?) + dict-ref-id t126-hashtable-ref* + dict-ref/default-id t126-hashtable-ref/default* + dict-set-id t126-hashtable-set* + dict-delete-all-id t126-hashtable-delete-all* + dict-intern-id t126-hashtable-intern* + dict-update/default-id t126-hashtable-update/default* + dict-pop-id t126-hashtable-pop* + dict-map-id t126-hashtable-update-all* + dict-filter-id t126-hashtable-filter* + dict-remove-id t126-hashtable-remove* + dict-find-update-id t126-hashtable-find-update* + dict-size-id (prep-dto-arg t126-hashtable-size) + dict-keys-id t126-hashtable-keys* + dict-values-id t126-hashtable-values* + dict-entries-id t126-hashtable-entries* + dict-map->list-id t126-hashtable-map->lset* + dict-comparator-id t126-hashtable-comparator*)))) |
