Generalize period-based definitions lookup.

member-fees.scm

@@ -57,29 +57,11 @@
 
  ;; Convert into lookups - a list of (list period regular student)
  (define member-fees-lookup-table
-   (map
-    (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))
+   (make-period-lookup-table member-fees-lookup-source))
 
  ;; Returns a matching list of (list regular student)
  (define (lookup-member-fees)
-   (let loop ((lst member-fees-lookup-table))
-     (if (null? lst)
-	 #f
-	 (if (month-in-period? (caar lst))
-	     (cdar lst)
-	     (loop (cdr lst))))))
+   (lookup-by-period member-fees-lookup-table))
 
  ;; Returns time-based fee for given type
  (define (lookup-member-fee type)

period.scm

@@ -39,6 +39,8 @@
   month-in-periods?
   periods->string
   periods-match
+  make-period-lookup-table
+  lookup-by-period
   period-tests!
   )
 
@@ -171,6 +173,30 @@
 	       (car 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.
  (define (period-tests!)
    (run-tests