Generalize period lookups.

This commit is contained in:
Dominik Pantůček 2023-03-31 20:56:42 +02:00
parent 51b3b6f5b7
commit e9745bc64a
2 changed files with 17 additions and 17 deletions

View file

@ -51,13 +51,10 @@
members-base members-base
period) period)
;; Specifications of fees, regular and student must be in all
(define member-fees-lookup-source
'(((2010 1) #f 500 250)))
;; Convert into lookups - a list of (list period regular student) ;; Convert into lookups - a list of (list period regular student)
(define member-fees-lookup-table (define member-fees-lookup-table
(make-period-lookup-table member-fees-lookup-source)) (make-period-lookup-table
'(((2010 1) 500 250))))
;; Returns a matching list of (list regular student) ;; Returns a matching list of (list regular student)
(define (lookup-member-fees) (define (lookup-member-fees)

View file

@ -175,18 +175,21 @@
;; Creates lookup table from definition source ;; Creates lookup table from definition source
(define (make-period-lookup-table source) (define (make-period-lookup-table source)
(map (let loop ((lst source)
(lambda (src) (res '())
(let* ((since0 (car src)) (prev #f))
(since (apply make-month since0)) (if (null? lst)
(before0 (cadr src)) (reverse
(before (if before0 (cons (cons (make-period (car prev) #f)
(apply make-month before0) (cdr prev))
#f)) res))
(definitions (cddr src))) (loop (cdr lst)
(cons (make-period since before) (if prev
definitions))) (cons (cons (make-period (car prev) (caar lst))
source)) (cdr prev))
res)
res)
(car lst)))))
;; Looks up current month and returns associated definitions ;; Looks up current month and returns associated definitions
(define (lookup-by-period table) (define (lookup-by-period table)