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

Fix month computation.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-19 19:06:22 +01:00
parent 5ff4aaff1b
commit a4a296f36b
3 changed files with 16 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

8
month.scm
View file

@ -113,17 +113,17 @@
(define (month-diff f t)
(if (month-valid? f)
(if (month-valid? t)
(let ((F (+ (* (car f) 12) (cadr f)))
(T (+ (* (car t) 12) (cadr t))))
(let ((F (+ (* (car f) 12) (cadr f) -1))
(T (+ (* (car t) 12) (cadr t) -1)))
(- T F))
(error 'month-diff "Second argument is not a valid month" t))
(error 'month-diff "First argument is not a valid month" f)))
;; Returns a month n months after the month m.
(define (month-add m n)
(let ((mi (+ (* 12 (car m)) (cadr m) n)))
(let ((mi (+ (* 12 (car m)) (cadr m) n -1)))
(list (quotient mi 12)
(remainder mi 12))))
(+ (remainder mi 12) 1))))
;; Performs self-tests of the month module.
(define (month-tests!)