brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Implement dict-map.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-16 10:22:50 +01:00
parent 6e614feab3
commit 33f02bd329
3 changed files with 31 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

3
Makefile
View file

@ -92,7 +92,8 @@ COMMAND-LINE-SOURCES=command-line.scm testing.import.scm
command-line.o: $(COMMAND-LINE-SOURCES) command-line.o: $(COMMAND-LINE-SOURCES)
command-line.import.scm: $(COMMAND-LINE-SOURCES) command-line.import.scm: $(COMMAND-LINE-SOURCES)
MEMBERS-BASE-SOURCES=members-base.scm testing.import.scm MEMBERS-BASE-SOURCES=members-base.scm testing.import.scm \
utils.import.scm dictionary.import.scm member-file.import.scm
members-base.o: $(MEMBERS-BASE-SOURCES) members-base.o: $(MEMBERS-BASE-SOURCES)
members-base.import.scm: $(MEMBERS-BASE-SOURCES) members-base.import.scm: $(MEMBERS-BASE-SOURCES)

21
dictionary.scm
View file

@ -91,6 +91,17 @@
(define (dict-keys d) (define (dict-keys d)
(map car d)) (map car d))
;; Maps dictionary values, the procedure gets key-value pairs if it
;; accepts more than one argument.
(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)))
;; Performs self-tests of the dictionary module. ;; Performs self-tests of the dictionary module.
(define (dictionary-tests!) (define (dictionary-tests!)
(run-tests (run-tests
@ -103,6 +114,16 @@
(test-exn dict-remove (dict-remove (make-dict) 'nonexistent)) (test-exn dict-remove (dict-remove (make-dict) 'nonexistent))
(test-true dict-remove (null? (dict-remove (dict-set (make-dict) 'existing 1) 'existing))) (test-true dict-remove (null? (dict-remove (dict-set (make-dict) 'existing 1) 'existing)))
(test-equal? dict-keys (dict-keys (dict-set (make-dict) 'existing 1)) '(existing)) (test-equal? dict-keys (dict-keys (dict-set (make-dict) 'existing 1)) '(existing))
(test-equal? dict-map (dict-map (lambda (v) (* 2 v))
'((a . 1)
(b . 2)))
'((a . 2)
(b . 4)))
(test-equal? dict-map (dict-map (lambda (k v) (* 2 v))
'((a . 1)
(b . 2)))
'((a . 2)
(b . 4)))
)) ))
) )

10
members-base.scm
View file

@ -41,7 +41,8 @@
(chicken irregex) (chicken irregex)
testing testing
utils utils
dictionary) dictionary
member-file)
;; Gets all files and symbolic links from given directory. The ;; Gets all files and symbolic links from given directory. The
;; symbolic links are represented by cons cells with car being the ;; symbolic links are represented by cons cells with car being the
@ -135,7 +136,12 @@
;; member-file module returns. The id key contains whatever is the ;; member-file module returns. The id key contains whatever is the
;; first 4-digit symbol in (cons fname aliases) list. ;; first 4-digit symbol in (cons fname aliases) list.
(define (members-base-load-member mdir fname aliases) (define (members-base-load-member mdir fname aliases)
#f) (let* ((mr0 (make-dict))
(mr-fn (dict-set mr0 'file-name fname))
(mr-sl (dict-set mr-fn 'symlinks aliases)))
(dict-set mr-sl 'info
(load-member-file
(make-pathname mdir fname)))))
(define (load-members dn) (define (load-members dn)
;; get the directory contents ;; get the directory contents