Use 3-argument dict-map mapping function.

This commit is contained in:
Dominik Pantůček 2023-03-31 10:16:32 +02:00
parent d58a84e26e
commit a195b2d4aa
2 changed files with 21 additions and 11 deletions

View file

@ -100,15 +100,27 @@
(map car d))
;; 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)
(let ((both? (> (length (procedure-information proc)) 2)))
(map
(lambda (kv)
(let ((k (car kv))
(v (cdr kv)))
(cons k (if both? (proc k v) (proc v)))))
d)))
(let* ((lpi (length (procedure-information proc)))
(both? (> lpi 2))
(index? (> lpi 3)))
(let loop ((d d)
(r '())
(i 0))
(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
;; predicate which must accept two arguments. Unlike list filter,

View file

@ -68,11 +68,9 @@
progress? "members"
(let* ((fss (load-members-dir dn))
(tot (sub1 (length (dict-keys fss))))
(prg 0)
(mb0 (dict-map
(lambda (symfn symlinks)
(lambda (symfn symlinks prg)
(progress%-advance (/ prg tot))
(set! prg (add1 prg))
(members-dir-load-member dn
symfn
symlinks))