Work on migrating to the new dictionary implementation.
This commit is contained in:
parent
42466416cd
commit
ced789ca06
7 changed files with 69 additions and 68 deletions
|
|
@ -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.
|
||||
|
|
|
|||
25
src/Makefile
25
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 \
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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!)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue