Generalize period-based definitions lookup.
This commit is contained in:
parent
4a62102bc2
commit
51b3b6f5b7
2 changed files with 28 additions and 20 deletions
|
@ -57,29 +57,11 @@
|
||||||
|
|
||||||
;; 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
|
||||||
(map
|
(make-period-lookup-table member-fees-lookup-source))
|
||||||
(lambda (src)
|
|
||||||
(let* ((since0 (car src))
|
|
||||||
(since (apply make-month since0))
|
|
||||||
(before0 (cadr src))
|
|
||||||
(before (if before0
|
|
||||||
(apply make-month before0)
|
|
||||||
#f))
|
|
||||||
(regular (caddr src))
|
|
||||||
(student (cadddr src)))
|
|
||||||
(list (make-period since before)
|
|
||||||
regular
|
|
||||||
student)))
|
|
||||||
member-fees-lookup-source))
|
|
||||||
|
|
||||||
;; Returns a matching list of (list regular student)
|
;; Returns a matching list of (list regular student)
|
||||||
(define (lookup-member-fees)
|
(define (lookup-member-fees)
|
||||||
(let loop ((lst member-fees-lookup-table))
|
(lookup-by-period member-fees-lookup-table))
|
||||||
(if (null? lst)
|
|
||||||
#f
|
|
||||||
(if (month-in-period? (caar lst))
|
|
||||||
(cdar lst)
|
|
||||||
(loop (cdr lst))))))
|
|
||||||
|
|
||||||
;; Returns time-based fee for given type
|
;; Returns time-based fee for given type
|
||||||
(define (lookup-member-fee type)
|
(define (lookup-member-fee type)
|
||||||
|
|
26
period.scm
26
period.scm
|
@ -39,6 +39,8 @@
|
||||||
month-in-periods?
|
month-in-periods?
|
||||||
periods->string
|
periods->string
|
||||||
periods-match
|
periods-match
|
||||||
|
make-period-lookup-table
|
||||||
|
lookup-by-period
|
||||||
period-tests!
|
period-tests!
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -171,6 +173,30 @@
|
||||||
(car ps)
|
(car ps)
|
||||||
(loop (cdr ps)))))))
|
(loop (cdr ps)))))))
|
||||||
|
|
||||||
|
;; Creates lookup table from definition source
|
||||||
|
(define (make-period-lookup-table source)
|
||||||
|
(map
|
||||||
|
(lambda (src)
|
||||||
|
(let* ((since0 (car src))
|
||||||
|
(since (apply make-month since0))
|
||||||
|
(before0 (cadr src))
|
||||||
|
(before (if before0
|
||||||
|
(apply make-month before0)
|
||||||
|
#f))
|
||||||
|
(definitions (cddr src)))
|
||||||
|
(cons (make-period since before)
|
||||||
|
definitions)))
|
||||||
|
source))
|
||||||
|
|
||||||
|
;; Looks up current month and returns associated definitions
|
||||||
|
(define (lookup-by-period table)
|
||||||
|
(let loop ((lst table))
|
||||||
|
(if (null? lst)
|
||||||
|
#f
|
||||||
|
(if (month-in-period? (caar lst))
|
||||||
|
(cdar lst)
|
||||||
|
(loop (cdr lst))))))
|
||||||
|
|
||||||
;; Performs self-tests of the period module.
|
;; Performs self-tests of the period module.
|
||||||
(define (period-tests!)
|
(define (period-tests!)
|
||||||
(run-tests
|
(run-tests
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue