; passover
(define (julian year month day)
(let* ((a (quotient (- 14 month) 12))
(y (+ year 4800 (- a)))
(m (+ month (* 12 a) -3)))
(+ day
(quotient (+ (* 153 m) 2) 5)
(* 365 y)
(quotient y 4)
(- (quotient y 100))
(quotient y 400)
(- 32045))))
(define (gregorian julian)
(let* ((j (+ julian 32044))
(g (quotient j 146097))
(dg (modulo j 146097))
(c (quotient (* (+ (quotient dg 36524) 1) 3) 4))
(dc (- dg (* c 36524)))
(b (quotient dc 1461))
(db (modulo dc 1461))
(a (quotient (* (+ (quotient db 365) 1) 3) 4))
(da (- db (* a 365)))
(y (+ (* g 400) (* c 100) (* b 4) a))
(m (- (quotient (+ (* da 5) 308) 153) 2))
(d (+ da (- (quotient (* (+ m 4) 153) 5)) 122))
(year (+ y (- 4800) (quotient (+ m 2) 12)))
(month (+ (modulo (+ m 2) 12) 1))
(day (+ d 1)))
(values year month day)))
(define (rosh-hashanah year)
(let* ((g (+ (remainder year 19) 1))
(r (remainder (* 12 g) 19))
(n (+ (- (quotient year 100) (quotient year 400) 2)
(* 765433 r 1/492480)
(/ (remainder year 4) 4)
(- (/ (+ (* 313 year) 89081) 98496))))
(d (quotient (numerator n) (denominator n)))
(f (- n d))
(j (julian year 9 d)))
(case (modulo j 7)
((2 4 6) (+ j 1))
((0) (if (and (>= f 23269/25920) (> r 11)) (+ j 1) j))
((1) (if (and (>= f 1367/2160) (> r 6)) (+ j 2) j))
(else j))))
(define (passover year)
(let-values (((y m d) (gregorian (rosh-hashanah year))))
(let ((j (julian year 3 21)))
(if (= m 9) (+ j d) (+ j d 30)))))
(call-with-values
(lambda () (gregorian (passover 2010)))
(lambda (y m d)
(display y) (newline)
(display m) (newline)
(display d) (newline)))