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

Day comparators.

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

45
src/cal-day.scm
View file

@ -42,6 +42,12 @@
string->cal-day
parse-cal-day/month
cal-day=?
cal-day<?
cal-day<=?
cal-day>=?
cal-day>?
cal-day-tests!
)
@ -146,6 +152,45 @@
(or d
(string->cal-month s))))
;; Date equality
(define (cal-day=? a b)
(and (cal-day? a)
(cal-day? b)
(eq? (cal-day-year a)
(cal-day-year b))
(eq? (cal-day-month a)
(cal-day-month b))
(eq? (cal-day-day a)
(cal-day-day b))))
;; Strict date inequality
(define (cal-day<? a b)
(and (cal-day? a)
(cal-day? b)
(or (< (cal-day-year a)
(cal-day-year b))
(and (= (cal-day-year a)
(cal-day-year b))
(or (< (cal-day-month a)
(cal-day-month b))
(and (= (cal-day-month a)
(cal-day-month b))
(< (cal-day-day a)
(cal-day-day b))))))))
;; Non-strict inequality
(define (cal-day<=? a b)
(or (cal-day=? a b)
(cal-day<? a b)))
;; Inequality the other way
(define (cal-day>=? a b)
(not (cal-day<? a b)))
;; Strict inequality the other way
(define (cal-day>? a b)
(not (cal-day<=? a b)))
;; Module self-tests
(define (cal-day-tests!)
(run-tests