diff --git a/doc/utils.md b/doc/utils.md index bf86b70..c517eda 100644 --- a/doc/utils.md +++ b/doc/utils.md @@ -33,7 +33,7 @@ Splits given loaded CSV into two tables at the first empty row. ### Dictionary - (import util-dict) + (import util-dict-list) This module implements a simple key/value dictionary using lists as backend. All operations are O(n) with respect to time. diff --git a/src/Makefile b/src/Makefile index 31fcfb1..110f433 100644 --- a/src/Makefile +++ b/src/Makefile @@ -40,7 +40,7 @@ HACKERBASE-DEPS=hackerbase.scm month.import.scm \ tests.import.scm HACKERBASE-OBJS=hackerbase.o testing.o listing.o month.o period.o ansi.o \ - util-dict.o command-line.o members-base.o primes.o \ + util-dict-list.o command-line.o members-base.o primes.o \ member-record.o configuration.o progress.o table.o cards.o \ members-print.o member-fees.o members-dir.o util-csv.o \ bank-account.o bank-fio.o members-payments.o member-parser.o \ @@ -90,10 +90,11 @@ LISTING-SOURCES=listing.scm testing.import.scm ansi.import.scm listing.o: listing.import.scm listing.import.scm: $(LISTING-SOURCES) -UTIL-DICT-SOURCES=util-dict.scm testing.import.scm +UTIL-DICT-LIST-SOURCES=util-dict-list.scm testing.import.scm \ + util-tag.import.scm -util-dict.o: util-dict.import.scm -util-dict.import.scm: $(UTIL-DICT-SOURCES) +util-dict-list.o: util-dict-list.import.scm +util-dict-list.import.scm: $(UTIL-DICT-LIST-SOURCES) MONTH-SOURCES=month.scm testing.import.scm @@ -118,7 +119,7 @@ command-line.o: command-line.import.scm command-line.import.scm: $(COMMAND-LINE-SOURCES) MEMBERS-BASE-SOURCES=members-base.scm testing.import.scm \ - util-dict.import.scm primes.import.scm \ + util-dict-list.import.scm primes.import.scm \ member-record.import.scm ansi.import.scm period.import.scm \ month.import.scm configuration.import.scm \ progress.import.scm table.import.scm members-dir.import.scm \ @@ -137,7 +138,7 @@ PRIMES-SOURCES=primes.scm testing.import.scm util-list.import.scm primes.o: primes.import.scm primes.import.scm: $(PRIMES-SOURCES) -MEMBER-RECORD-SOURCES=member-record.scm util-dict.import.scm \ +MEMBER-RECORD-SOURCES=member-record.scm util-dict-list.import.scm \ period.import.scm testing.import.scm month.import.scm \ configuration.import.scm primes.import.scm \ bank-account.import.scm util-list.import.scm @@ -162,14 +163,14 @@ TABLE-SOURCES=table.scm ansi.import.scm testing.import.scm \ table.o: table.import.scm table.import.scm: $(TABLE-SOURCES) -CARDS-SOURCES=cards.scm util-dict.import.scm members-base.import.scm \ +CARDS-SOURCES=cards.scm util-dict-list.import.scm members-base.import.scm \ member-record.import.scm cards.o: cards.import.scm cards.import.scm: $(CARDS-SOURCES) MEMBER-PARSER-SOURCES=member-parser.scm member-record.import.scm \ - testing.import.scm util-dict.import.scm month.import.scm \ + testing.import.scm util-dict-list.import.scm month.import.scm \ period.import.scm configuration.import.scm \ util-string.import.scm util-list.import.scm \ util-parser.import.scm @@ -177,7 +178,7 @@ MEMBER-PARSER-SOURCES=member-parser.scm member-record.import.scm \ member-parser.o: member-parser.import.scm member-parser.import.scm: $(MEMBER-PARSER-SOURCES) -MEMBERS-PRINT-SOURCES=members-print.scm util-dict.import.scm \ +MEMBERS-PRINT-SOURCES=members-print.scm util-dict-list.import.scm \ member-record.import.scm month.import.scm table.import.scm \ listing.import.scm ansi.import.scm period.import.scm \ primes.import.scm members-base.import.scm \ @@ -196,7 +197,7 @@ member-fees.o: member-fees.import.scm member-fees.import.scm: $(MEMBER-FEES-SOURCES) MEMBERS-DIR-SOURCES=members-dir.scm testing.import.scm \ - util-dict.import.scm member-record.import.scm \ + util-dict-list.import.scm member-record.import.scm \ member-parser.import.scm util-list.import.scm members-dir.o: members-dir.import.scm @@ -220,7 +221,7 @@ bank-fio.o: bank-fio.import.scm bank-fio.import.scm: $(BANK-FIO-SOURCES) MEMBERS-PAYMENTS-SOURCES=members-payments.scm bank-account.import.scm \ - util-dict.import.scm member-fees.import.scm \ + util-dict-list.import.scm member-fees.import.scm \ period.import.scm configuration.import.scm \ progress.import.scm bank-fio.import.scm util-list.import.scm @@ -293,7 +294,7 @@ TEXTS-SOURCES=texts.scm texts.o: texts.import.scm texts.import.scm: $(TEXTS-SOURCES) -TESTS-SOURCES=tests.scm listing.import.scm util-dict.import.scm \ +TESTS-SOURCES=tests.scm listing.import.scm util-dict-list.import.scm \ month.import.scm period.import.scm util-list.import.scm \ ansi.import.scm command-line.import.scm \ members-dir.import.scm primes.import.scm \ diff --git a/src/member-parser.scm b/src/member-parser.scm index 0238fd1..978b09c 100644 --- a/src/member-parser.scm +++ b/src/member-parser.scm @@ -37,7 +37,7 @@ (chicken irregex) member-record testing - dictionary + util-dict-list month period util-list @@ -163,9 +163,9 @@ ;; number, known multikeys as lists of pairs of value and line ;; number. (define (process-member-file mr) - (let loop ((parsed (dict-ref mr 'parsed)) + (let loop ((parsed (ldict-ref mr 'parsed)) (mr mr) - (processed (make-dict))) + (processed (make-ldict))) (if (null? parsed) (member-record-set mr #:processed processed) (let* ((line (car parsed)) @@ -173,18 +173,18 @@ (value (cadr line)) (number (caddr line))) (if (member key known-keys) - (if (dict-has-key? processed key) + (if (ldict-contains? processed key) (loop (cdr parsed) (member-record-add-highlight mr number "Duplicate key" 2 'error) processed) (loop (cdr parsed) mr - (dict-set processed key (cons value number)))) + (ldict-set processed key (cons value number)))) (if (member key known-multikeys) (loop (cdr parsed) mr - (dict-set processed key (cons (cons value number) - (dict-ref processed key '())))) + (ldict-set processed key (cons (cons value number) + (ldict-ref processed key '())))) (loop (cdr parsed) (if (member key ignored-keys) mr @@ -194,14 +194,14 @@ ;; Pass 3+: Single interpreter pass - input must be ;; dictionary. Output is top-level key of member record. (define (interpreter-pass mr output input pass-proc) - (let loop ((keys (dict-keys input)) - (mr (dict-set mr output (make-dict)))) + (let loop ((keys (ldict-keys input)) + (mr (ldict-set mr output (make-ldict)))) (if (null? keys) mr (let ((key (car keys))) (loop (cdr keys) (pass-proc mr output key - (dict-ref input key))))))) + (ldict-ref input key))))))) ;; Pass 3+: Interpreter passes (define (interpret-member-file mr . starts) @@ -218,7 +218,7 @@ (pass-proc (cadr pass))) (loop (cdr passes) (caar passes) - (interpreter-pass mr pass-name (dict-ref mr prev-name) pass-proc))))))) + (interpreter-pass mr pass-name (ldict-ref mr prev-name) pass-proc))))))) ;; Loads member file source. Performs passes 0, 1 and 2. (define (load-member-file mr) diff --git a/src/member-record.scm b/src/member-record.scm index d350b19..3542a4b 100644 --- a/src/member-record.scm +++ b/src/member-record.scm @@ -80,7 +80,7 @@ (chicken irregex) (chicken string) (chicken format) - dictionary + util-dict-list testing month period @@ -121,7 +121,7 @@ (symbol->string (get-4digit-symbol-from-list (cons file-name symlinks)))))))) (if (null? args) - (make-dict pairs) + (make-ldict pairs) (if (not (keyword? (car args))) (error 'make-member-record "Optional arguments must be keywords" (car args)) (if (null? (cdr args)) @@ -133,16 +133,16 @@ ;; File name without directory (define (member-file-name mr) - (dict-ref mr 'file-name)) + (ldict-ref mr 'file-name)) ;; Convenience accessor for file name with directory (define (member-file-path mr) - (dict-ref mr 'file-path)) + (ldict-ref mr 'file-path)) ;; Returns opened input file for this record (used by parser). (define (member-record-input-file mr) (open-input-file - (dict-ref mr 'file-path))) + (ldict-ref mr 'file-path))) ;; Sets pairs of keys/values for given member record. (define (member-record-set mr . args) @@ -155,28 +155,28 @@ (if (null? (cdr args)) (error 'member-record-set "Argument needs value" (car args)) (loop (cddr args) - (dict-set mr (string->symbol (keyword->string (car args))) + (ldict-set mr (string->symbol (keyword->string (car args))) (cadr args)))))))) ;; Adds highlight identified by line number, message, pass number and ;; type (error, warning, info). (define (member-record-add-highlight mr line-number message pass type) - (dict-set mr 'highlights + (ldict-set mr 'highlights (cons (list line-number message pass type) - (dict-ref mr 'highlights '())))) + (ldict-ref mr 'highlights '())))) ;; Returns a key from particular section (define (member-record-sub-ref mr sec key . defaults) - (let ((sec-dict (dict-ref mr sec))) + (let ((sec-dict (ldict-ref mr sec))) (if (null? defaults) - (dict-ref sec-dict key) - (dict-ref sec-dict key (car defaults))))) + (ldict-ref sec-dict key) + (ldict-ref sec-dict key (car defaults))))) ;; Sets a key in particular section (define (member-record-sub-set mr sec key val) - (let ((sec-dict (dict-ref mr sec))) - (dict-set mr sec - (dict-set sec-dict key val)))) + (let ((sec-dict (ldict-ref mr sec))) + (ldict-set mr sec + (ldict-set sec-dict key val)))) ;; Prepends value to given subkey (define (member-record-sub-prepend mr sec key val) @@ -186,49 +186,49 @@ ;; Returns true if given section contains given key (define (member-record-sub-has-key? mr sec key) - (dict-has-key? (dict-ref mr sec) key)) + (ldict-contains? (ldict-ref mr sec) key)) ;; Returns new member record with section updated by defaults, the ;; section must already exist. (define (member-record-sub-ensure mr sec . kvs) (let loop ((kvs kvs) - (sd (dict-ref mr sec))) + (sd (ldict-ref mr sec))) (if (null? kvs) - (dict-set mr sec sd) + (ldict-set mr sec sd) (if (null? (cdr kvs)) (error 'member-record-sub-ensure "Needs pairs of keys and values" kvs) (let ((key (car kvs)) (val (cadr kvs))) (loop (cddr kvs) - (if (dict-has-key? sd key) + (if (ldict-contains? sd key) sd - (dict-set sd key val)))))))) + (ldict-set sd key val)))))))) ;; Returns source lines (define (member-source mr) - (dict-ref mr 'source '())) + (ldict-ref mr 'source '())) ;; Returns member info key value (define (member-record-info mr key . defaults) - (let ((info (dict-ref mr 'info))) + (let ((info (ldict-ref mr 'info))) (if (null? defaults) - (dict-ref info key) - (dict-ref info key (car defaults))))) + (ldict-ref info key) + (ldict-ref info key (car defaults))))) ;; Return mandatory keys with #f as value (define (member-missing-keys mr) - (dict-reduce '() + (ldict-reduce '() (lambda (acc k v) (if v acc (cons k acc))) - (dict-ref mr 'info))) + (ldict-ref mr 'info))) ;; True if there are any source highlights (define (member-has-highlights? mr) - (dict-has-key? mr 'highlights)) + (ldict-contains? mr 'highlights)) ;; Returns true if there is at least one highlight of given type (define (member-highlights-has-type? mr type) - (let loop ((hls (dict-ref mr 'highlights '()))) + (let loop ((hls (ldict-ref mr 'highlights '()))) (if (null? hls) #f (if (eq? (cadddr (car hls)) type) @@ -241,7 +241,7 @@ ;; Absolutely required (define (member-record-usable? mr) - (dict-has-key? (dict-ref mr 'info) 'member)) + (ldict-contains? (ldict-ref mr 'info) 'member)) ;; True if member record is OK (define (member-has-problems? mr) @@ -309,7 +309,7 @@ ;; Returns member id (define (member-id mr) - (dict-ref mr 'id)) + (ldict-ref mr 'id)) ;; Returns the number of months the user is suspended. Zero if not ;; suspended. @@ -335,7 +335,7 @@ ((#\I) (number->string (member-record-info mr 'id))) ((#\S) (number->string (member-suspended-months mr))) ((#\E) - (let ((n (length (dict-ref mr 'highlights '())))) + (let ((n (length (ldict-ref mr 'highlights '())))) (if (eq? n 0) "" (sprintf "[~A]" n)))) @@ -351,9 +351,9 @@ ;; Prepends new payment to given member record payments (define (member-record-add-payment mr pt) - (dict-set mr 'payments + (ldict-set mr 'payments (cons pt - (dict-ref mr 'payments '())))) + (ldict-ref mr 'payments '())))) ;; Returns alist of member payments (define (member-payments mr) @@ -361,15 +361,15 @@ (let* ((isodate (bank-transaction-date tr)) (month (iso-date->month isodate))) (month<=? month (*current-month*)))) - (dict-ref mr 'payments '()))) + (ldict-ref mr 'payments '()))) ;; Returns a list of MLs this member is subscribed to (define (member-mailman mr) - (dict-ref mr 'mailman '())) + (ldict-ref mr 'mailman '())) ;; Adds given ML to given member record (define (member-add-mailman mr ml) - (dict-set mr 'mailman + (ldict-set mr 'mailman (cons ml (member-mailman mr)))) diff --git a/src/members-dir.scm b/src/members-dir.scm index bb15cb0..28f3b21 100644 --- a/src/members-dir.scm +++ b/src/members-dir.scm @@ -41,7 +41,7 @@ (chicken format) (chicken irregex) testing - dictionary + util-dict-list util-list member-record member-parser) @@ -76,11 +76,11 @@ (files (filter symbol? ls)) (fdict (let loop ((files files) - (res (make-dict))) + (res (make-ldict))) (if (null? files) res (loop (cdr files) - (dict-set res (car files) '())))))) + (ldict-set res (car files) '())))))) (let loop ((links links) (res fdict) (errs 0)) @@ -89,12 +89,12 @@ (let* ((link (car links)) (name (car link)) (target (cdr link))) - (if (dict-has-key? res target) + (if (ldict-contains? res target) (loop (cdr links) - (dict-set res target (cons name (dict-ref res target))) + (ldict-set res target (cons name (ldict-ref res target))) errs) (loop (cdr links) - (dict-set res target + (ldict-set res target (list (string->symbol (sprintf "error-~A" errs)) name)) (+ errs 1)))))))) @@ -132,7 +132,7 @@ ;; Returns dictionary containing only records with either 4-digit ;; name or one of its aliases being 4-digit. (define (files-dictionary-filter-4digit-symbols d) - (dict-filter + (ldict-filter (lambda (k v) (list-contains-4digit-symbol? (cons k v))) d)) diff --git a/src/tests.scm b/src/tests.scm index 6fa9831..b18990b 100644 --- a/src/tests.scm +++ b/src/tests.scm @@ -33,7 +33,7 @@ (import scheme listing - dictionary + util-dict-list month period util-list @@ -49,7 +49,7 @@ (define (run-all-tests!) (listing-tests!) - (dictionary-tests!) + (ldict-tests!) (month-tests!) (period-tests!) (util-list-tests!) diff --git a/src/util-dict.scm b/src/util-dict-list.scm similarity index 100% rename from src/util-dict.scm rename to src/util-dict-list.scm