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

Universal sorting of markers.

Browse source
This commit is contained in:
Dominik Pantůček 2023-05-19 21:15:56 +02:00
parent 0265dc3617
commit c9ba551132
2 changed files with 15 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

14
src/cal-day.scm
View file

@ -48,6 +48,8 @@
cal-day>=? cal-day>=?
cal-day>? cal-day>?
cal-day/month<?
cal-day-tests! cal-day-tests!
) )
@ -191,6 +193,18 @@
(define (cal-day>? a b) (define (cal-day>? a b)
(not (cal-day<=? a b))) (not (cal-day<=? a b)))
;; Universal sorting comparator
(define (cal-day/month<? a b)
(if (and (cal-day? a)
(cal-day? b))
(cal-day<? a b)
(if (and (cal-month? a)
(cal-month? b))
(cal-month<? a b)
(error 'cal-day/month<?
"Requires two arguments of the same type"
(list a b)))))
;; Module self-tests ;; Module self-tests
(define (cal-day-tests!) (define (cal-day-tests!)
(run-tests (run-tests

2
src/cal-period.scm
View file

@ -130,7 +130,7 @@
(define (sort-period-markers l) (define (sort-period-markers l)
(sort l (sort l
(lambda (a b) (lambda (a b)
(cal-month<? (cadr a) (cadr b))))) (cal-day/month<? (cadr a) (cadr b)))))
;; Converts list of start/stop markers to list of pairs of months - ;; Converts list of start/stop markers to list of pairs of months -
;; periods. The markers are lists in the form (start/stop cal-month). ;; periods. The markers are lists in the form (start/stop cal-month).