diff options
| author | 2021-11-11 20:09:12 +0200 | |
|---|---|---|
| committer | 2021-11-11 20:09:12 +0200 | |
| commit | f1b1e37b57ff1ecf1e7dd18dbb9204c402edf3c2 (patch) | |
| tree | d9c2e182d0bdbe1790afdf693f15b4adf23720a6 /srfi/plist-impl.scm | |
| parent | Merge remote-tracking branch 'arvyy/master' (diff) | |
remove min-key, max-key, plist; add dependencies list to html
Diffstat (limited to '')
| -rw-r--r-- | srfi/plist-impl.scm | 111 |
1 files changed, 0 insertions, 111 deletions
diff --git a/srfi/plist-impl.scm b/srfi/plist-impl.scm deleted file mode 100644 index d291870..0000000 --- a/srfi/plist-impl.scm +++ /dev/null @@ -1,111 +0,0 @@ -(define plist-dtd - (let () - - (define (plist? dtd l) - (and (list? l) - (or (null? l) - (symbol? (car l))))) - - (define (plist-map dtd proc plist) - (let loop ((pl plist) - (new-pl/rev '())) - (cond - ((null? pl) (reverse new-pl/rev)) - ((null? (cdr pl)) (error "Malformed plist" plist)) - (else - (let ((key (car pl)) - (value (cadr pl)) - (rest (cddr pl))) - (loop rest - (append (list (proc key value) key) new-pl/rev))))))) - - (define (plist-filter dtd pred plist) - (let loop ((pl plist) - (new-pl/rev '())) - (cond - ((null? pl) (reverse new-pl/rev)) - ((null? (cdr pl)) (error "Malformed plist" plist)) - (else - (let ((key (car pl)) - (value (cadr pl)) - (rest (cddr pl))) - (if (pred key value) - (loop rest - (append (list value key) new-pl/rev)) - (loop rest - new-pl/rev))))))) - - (define (find-plist-entry key plist) - (cond - ((null? plist) #f) - ((eq? key (car plist)) plist) - (else (find-plist-entry key (cddr plist))))) - - (define (plist-delete key-to-delete plist) - (let loop ((pl plist) - (new-pl/rev '())) - (cond - ((null? pl) (reverse new-pl/rev)) - ((null? (cdr pl)) (error "Malformed plist")) - (else (let ((key (car pl)) - (value (cadr pl)) - (rest (cddr pl))) - (if (eq? key-to-delete key) - (loop rest new-pl/rev) - (loop rest (append (list value key) new-pl/rev)))))))) - - (define (plist-alter dtd plist key failure success) - (define (handle-success pair) - (define old-key (car pair)) - (define old-value (cadr pair)) - (define (update new-key new-value) - (cond - ((and (eq? old-key - new-key) - (eq? old-value - new-value)) - plist) - (else - (let ((new-list - (append (list new-key new-value) - (plist-delete old-key plist)))) - new-list)))) - (define (remove) - (plist-delete old-key plist)) - (success old-key old-value update remove)) - - (define (handle-failure) - (define (insert value) - (append (list key value) plist)) - (define (ignore) - plist) - (failure insert ignore)) - (cond - ((find-plist-entry key plist) => handle-success) - (else (handle-failure)))) - - (define (plist-size dtd plist) - (/ (length plist) 2)) - - (define (plist-foreach dtd proc plist) - (let loop ((pl plist)) - (if (null? pl) #t - (begin - (proc (car pl) (cadr pl)) - (loop (cddr pl)))))) - - (define (plist-mutable? dtd plist) - #f) - - (define (plist-comparator dtd plist) - #f) - - (make-dtd - dictionary?-id plist? - dict-mutable?-id plist-mutable? - dict-map-id plist-map - dict-filter-id plist-filter - dict-alter-id plist-alter - dict-size-id plist-size - dict-for-each-id plist-foreach - dict-comparator-id plist-comparator))) |
