blob: ba803d2af1c95f62136e52f1eb97a23a916b89b7 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
let mk y m d =
match Date.make ~year:y ~month:m ~day:d with
| Ok t -> t
| Error e -> failwith ("computus: " ^ e)
(* Anonymous Gregorian algorithm (Meeus / Jones / Butcher). *)
let gregorian_easter y =
let a = y mod 19 in
let b = y / 100 and c = y mod 100 in
let d = b / 4 and e = b mod 4 in
let f = (b + 8) / 25 in
let g = (b - f + 1) / 3 in
let h = ((19 * a) + b - d - g + 15) mod 30 in
let i = c / 4 and k = c mod 4 in
let l = (32 + (2 * e) + (2 * i) - h - k) mod 7 in
let m = (a + (11 * h) + (22 * l)) / 451 in
let month = (h + l - (7 * m) + 114) / 31 in
let day = ((h + l - (7 * m) + 114) mod 31) + 1 in
mk y month day
let anchor y offset = Date.add_days (gregorian_easter y) offset
let ash_wednesday y = anchor y (-46)
let palm_sunday y = anchor y (-7)
let ascension y = anchor y 39
let pentecost y = anchor y 49
let corpus_christi y = anchor y 60
(* Meeus Julian Easter: gives the JULIAN-calendar month/day; convert to the same
physical day expressed in the proleptic Gregorian calendar by adding the
Julian->Gregorian offset (days = y/100 - y/400 - 2). *)
let julian_easter y =
let a = y mod 4 and b = y mod 7 and c = y mod 19 in
let d = ((19 * c) + 15) mod 30 in
let e = ((2 * a) + (4 * b) - d + 34) mod 7 in
let month = (d + e + 114) / 31 in
let day = ((d + e + 114) mod 31) + 1 in
let offset = (y / 100) - (y / 400) - 2 in
Date.of_rata (Date.to_rata (mk y month day) + offset)
|
