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

Prepare cal-period sub-types.

Browse source
This commit is contained in:
Dominik Pantůček 2023-05-19 21:04:34 +02:00
parent 6d3b164751
commit abab18782b
1 changed files with 33 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

33
src/cal-period.scm
View file

@ -93,6 +93,39 @@
(define cal-period-scomment cadddr)
(define cal-period-bcomment (compose cadddr cdr))
;; Type predicate
(define (cal-period? p)
(and (pair? p)
(eq? (car p)
TAG-CAL-PERIOD)))
;; Month subtype predicate
(define (cal-period-month? p)
(and (cal-period? p)
(cal-month? (cal-period-since p))
(cal-month? (cal-period-before p))))
;; Day subtype predicate
(define (cal-period-day? p)
(and (cal-period? p)
(cal-day? (cal-period-since p))
(cal-day? (cal-period-before p))))
;; Validation
(define (cal-period-valid? p)
(and (pair? p)
(eq? (car p)
TAG-CAL-PERIOD)
(let ((since (cal-period-since p))
(before (cal-period-before p)))
(or (and (cal-month? since)
(cal-month? before)
(cal-month<=? since before))
(and (cal-day? since)
(cal-day? before)
;; (cal-day<=? since before)
)))))
;; Sorts period markers (be it start or end) chronologically and
;; returns the sorted list.
(define (sort-period-markers l)