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

Convert markers to periods.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-11 16:56:02 +01:00
parent 388843cada
commit d8676ebc1c
1 changed files with 29 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

30
brmsaptool.scm
View file

@ -229,8 +229,27 @@
(lambda (a b) (lambda (a b)
(month<? (cdr a) (cdr b))))) (month<? (cdr a) (cdr b)))))
;; Converts list of start/stop markers to list of pairs of months -
;; periods.
(define (period-markers->periods l) (define (period-markers->periods l)
l) (let loop ((l l)
(ps '())
(cb #f))
(if (null? l)
(if cb
(reverse (cons (cons cb #f) ps))
(reverse ps))
(let ((m (car l))
(rmt (if cb 'stop 'start)))
(if (eq? (car m) rmt)
(if cb
(loop (cdr l)
(cons (cons cb (cdr m)) ps)
#f)
(loop (cdr l)
ps
(cdr m)))
(error 'period-markers->periods "Invalid start/stop sequence marker" m))))))
(define (period-duration p) (define (period-duration p)
1) 1)
@ -243,6 +262,15 @@
(unit-test 'sort-period-markers (unit-test 'sort-period-markers
(equal? (sort-period-markers '((start 2023 1) (stop 2022 10) (start 2022 3))) (equal? (sort-period-markers '((start 2023 1) (stop 2022 10) (start 2022 3)))
'((start 2022 3) (stop 2022 10) (start 2023 1)))) '((start 2022 3) (stop 2022 10) (start 2023 1))))
(unit-test 'period-markers->periods
(equal? (period-markers->periods '((start 2022 3) (stop 2022 10) (start 2023 1) (stop 2023 4)))
'(((2022 3) . (2022 10))
((2023 1) . (2023 4)))))
(unit-test 'period-markers->periods-open
(equal? (period-markers->periods '((start 2022 3) (stop 2022 10) (start 2023 1) (stop 2023 4) (start 2023 5)))
'(((2022 3) . (2022 10))
((2023 1) . (2023 4))
((2023 5) . #f))))
(print " ok.")) (print " ok."))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;