diff --git a/Makefile b/Makefile index 3e0038e..a60cdb8 100644 --- a/Makefile +++ b/Makefile @@ -143,7 +143,7 @@ utils.so: utils.o utils.o: utils.import.scm utils.import.scm: $(UTILS-SOURCES) -PRIMES-SOURCES=primes.scm testing.import.scm +PRIMES-SOURCES=primes.scm testing.import.scm utils.import.scm primes.so: primes.o primes.o: primes.import.scm diff --git a/brmsaptool.scm b/brmsaptool.scm index eba698b..47f3c6c 100644 --- a/brmsaptool.scm +++ b/brmsaptool.scm @@ -78,6 +78,7 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. (-print () "Print given member file" (-action- 'print-member-file)) (-tests () "Run self-tests upon startup" (-run-tests?- #t)) + (-idstats () "Returns information about available member ids" (-action- 'print-idstats)) ) ;; Run tests @@ -127,4 +128,8 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. (print-member-source mr)) (else (print "No member specified!")))) + ((print-idstats) + (newline) + (print-members-ids-stats MB) + (newline)) ) diff --git a/member-file.scm b/member-file.scm index 2070704..f6d07e5 100644 --- a/member-file.scm +++ b/member-file.scm @@ -99,7 +99,8 @@ (print-source-listing lines (list highlight) (*member-file-context*) a:error a:default - "" "" "..."))) + "" "" "...") + (newline))) (if (eq? (*member-file-check-syntax*) 'error) (exit 1) (list member-file-error-symbol diff --git a/members-base.scm b/members-base.scm index a77dce8..501211f 100644 --- a/members-base.scm +++ b/members-base.scm @@ -36,6 +36,8 @@ members-base-stats print-members-base-info print-members-base-stats + get-free-members-ids + print-members-ids-stats members-base-tests! ) @@ -340,6 +342,31 @@ (print month " " (string-intersperse (map number->string vals) " ")) (loop (cdr rows))))))) + ;; Returns all free ids + (define (get-free-members-ids mb) + (let ((ids (list-members-ids mb))) + (filter + (lambda (id) + (not (member id ids))) + (gen-all-4digit-primes)))) + + ;; Prints statistics about allocated and unused valid/invalid IDs. + (define (print-members-ids-stats MB) + (print "Allocated IDs: " + (length (list-members-ids MB)) + "/" + (length (gen-all-4digit-primes)) + " (" + (length (get-free-members-ids MB)) + " free)") + (let ((iids (filter (compose not is-4digit-prime?) (list-members-ids MB)))) + (when (not (null? iids)) + (print " Invalid: " + (length iids) + " (" + (string-intersperse (map number->string iids) ", ") + ")")))) + ;; Performs self-tests of this module. (define (members-base-tests!) (run-tests diff --git a/primes.scm b/primes.scm index a8b7860..3544f46 100644 --- a/primes.scm +++ b/primes.scm @@ -30,11 +30,13 @@ ( primes-tests! is-4digit-prime? + gen-all-4digit-primes ) (import scheme (chicken base) - testing) + testing + utils) ;; Checks whether given number is prime by checking the remainder of ;; the division by all primes less than square root of the number in @@ -58,7 +60,7 @@ (define (gen-primes less-than . init) (let loop ((primes (if (null? init) '(2) - init)) + (car init))) (number 3)) (if (< number less-than) (loop (if (check-prime primes number) @@ -77,6 +79,11 @@ (<= n 9999) (check-prime primes<100 n))) + ;; Generates all valid member ids + (define (gen-all-4digit-primes) + (filter is-4digit-prime? + (gen-primes 10000 primes<100))) + ;; Module self-tests. (define (primes-tests!) (run-tests