Use 3-argument dict-map mapping function.
This commit is contained in:
parent
d58a84e26e
commit
a195b2d4aa
2 changed files with 21 additions and 11 deletions
|
@ -100,15 +100,27 @@
|
||||||
(map car d))
|
(map car d))
|
||||||
|
|
||||||
;; Maps dictionary values, the procedure gets key-value pairs if it
|
;; Maps dictionary values, the procedure gets key-value pairs if it
|
||||||
;; accepts more than one argument.
|
;; accepts more than one argument. If it accepts a third argument,
|
||||||
|
;; index gets passed as well.
|
||||||
(define (dict-map proc d)
|
(define (dict-map proc d)
|
||||||
(let ((both? (> (length (procedure-information proc)) 2)))
|
(let* ((lpi (length (procedure-information proc)))
|
||||||
(map
|
(both? (> lpi 2))
|
||||||
(lambda (kv)
|
(index? (> lpi 3)))
|
||||||
(let ((k (car kv))
|
(let loop ((d d)
|
||||||
(v (cdr kv)))
|
(r '())
|
||||||
(cons k (if both? (proc k v) (proc v)))))
|
(i 0))
|
||||||
d)))
|
(if (null? d)
|
||||||
|
r ; No reverse needed, order does not matter
|
||||||
|
(loop (cdr d)
|
||||||
|
(let ((k (caar d))
|
||||||
|
(v (cdar d)))
|
||||||
|
(cons (cons k (if both?
|
||||||
|
(if index?
|
||||||
|
(proc k v i)
|
||||||
|
(proc k v))
|
||||||
|
(proc v)))
|
||||||
|
r))
|
||||||
|
(add1 i))))))
|
||||||
|
|
||||||
;; Returns a dictionary containing only kv pairs matching the
|
;; Returns a dictionary containing only kv pairs matching the
|
||||||
;; predicate which must accept two arguments. Unlike list filter,
|
;; predicate which must accept two arguments. Unlike list filter,
|
||||||
|
|
|
@ -68,11 +68,9 @@
|
||||||
progress? "members"
|
progress? "members"
|
||||||
(let* ((fss (load-members-dir dn))
|
(let* ((fss (load-members-dir dn))
|
||||||
(tot (sub1 (length (dict-keys fss))))
|
(tot (sub1 (length (dict-keys fss))))
|
||||||
(prg 0)
|
|
||||||
(mb0 (dict-map
|
(mb0 (dict-map
|
||||||
(lambda (symfn symlinks)
|
(lambda (symfn symlinks prg)
|
||||||
(progress%-advance (/ prg tot))
|
(progress%-advance (/ prg tot))
|
||||||
(set! prg (add1 prg))
|
|
||||||
(members-dir-load-member dn
|
(members-dir-load-member dn
|
||||||
symfn
|
symfn
|
||||||
symlinks))
|
symlinks))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue