brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Prepare for universal day/month handling in queries.

Browse source
This commit is contained in:
Dominik Pantůček 2023-05-11 16:27:39 +02:00
parent ac1ae9b698
commit cbd17399e3
2 changed files with 12 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/Makefile
View file

@ -365,7 +365,7 @@ cal-month.o: cal-month.import.scm
cal-month.import.scm: $(CAL-MONTH-SOURCES) cal-month.import.scm: $(CAL-MONTH-SOURCES)
CAL-PERIOD-SOURCES=cal-period.scm cal-month.import.scm \ CAL-PERIOD-SOURCES=cal-period.scm cal-month.import.scm \
testing.import.scm util-tag.import.scm testing.import.scm util-tag.import.scm cal-day.import.scm
cal-period.o: cal-period.import.scm cal-period.o: cal-period.import.scm
cal-period.import.scm: $(CAL-PERIOD-SOURCES) cal-period.import.scm: $(CAL-PERIOD-SOURCES)

11
src/cal-period.scm
View file

@ -50,6 +50,8 @@
make-cal-period-lookup-table make-cal-period-lookup-table
lookup-by-cal-period lookup-by-cal-period
cal-ensure-month
cal-period-tests! cal-period-tests!
) )
@ -62,7 +64,8 @@
(chicken string) (chicken string)
cal-month cal-month
testing testing
util-tag) util-tag
cal-day)
;; Type tag ;; Type tag
(define TAG-CAL-PERIOD (make-tag CAL-PERIOD)) (define TAG-CAL-PERIOD (make-tag CAL-PERIOD))
@ -219,6 +222,12 @@
(cdar lst) (cdar lst)
(loop (cdr lst)))))) (loop (cdr lst))))))
;; Wrapper that accepts either day or month and returns testable month
(define (cal-ensure-month v . stop?s)
(if (cal-month? v)
v
(apply cal-day->month v stop?s)))
;; Performs self-tests of the period module. ;; Performs self-tests of the period module.
(define (cal-period-tests!) (define (cal-period-tests!)
(run-tests (run-tests