4 files changed, 79 insertions, 1 deletions
diff --git a/lib/kernel/computus.ml b/lib/kernel/computus.ml
new file mode 100644
index 0000000..1f60fb7
--- /dev/null
+++ b/lib/kernel/computus.ml
@@ -0,0 +1,31 @@
+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
+
+(* 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)
diff --git a/lib/kernel/computus.mli b/lib/kernel/computus.mli
new file mode 100644
index 0000000..dc8f215
--- /dev/null
+++ b/lib/kernel/computus.mli
@@ -0,0 +1,9 @@
+(** Ecclesiastical Easter. See docs/research/rules-register.md §0.
+    Both functions are total for a year in 1583..9999. *)
+
+(** Easter Sunday by the Gregorian reckoning (OF + EF). *)
+val gregorian_easter : int -> Date.t
+
+(** Easter Sunday by the Julian reckoning, returned as the equivalent proleptic
+    Gregorian date (for future eastern rites; EF/OF use {!gregorian_easter}). *)
+val julian_easter : int -> Date.t
diff --git a/test/test_colitur.ml b/test/test_colitur.ml
index 734257c..19671ce 100644
--- a/test/test_colitur.ml
+++ b/test/test_colitur.ml
@@ -1,2 +1,2 @@
 (* Aggregating test runner. Per-module suites live in test_<module>.ml. *)
-let () = Alcotest.run "colitur" [ Test_date.suite ]
+let () = Alcotest.run "colitur" [ Test_date.suite; Test_computus.suite ]
diff --git a/test/test_computus.ml b/test/test_computus.ml
new file mode 100644
index 0000000..1502ad2
--- /dev/null
+++ b/test/test_computus.ml
@@ -0,0 +1,38 @@
+module D = Colitur_kernel.Date
+module C = Colitur_kernel.Computus
+
+let ymd d = (D.year d, D.month d, D.day d)
+
+let test_gregorian_known () =
+  let cases = [ (2024, 3, 31); (2025, 4, 20); (2026, 4, 5); (2027, 3, 28); (2000, 4, 23); (1583, 4, 10) ] in
+  List.iter
+    (fun (y, m, d) ->
+      Alcotest.(check (triple int int int)) (Printf.sprintf "Gregorian Easter %d" y)
+        (y, m, d) (ymd (C.gregorian_easter y)))
+    cases
+
+let test_julian_known () =
+  (* Orthodox (Julian) Easter, expressed as the equivalent Gregorian date *)
+  let cases = [ (2023, 4, 16); (2024, 5, 5) ] in
+  List.iter
+    (fun (y, m, d) ->
+      Alcotest.(check (triple int int int)) (Printf.sprintf "Julian Easter %d" y)
+        (y, m, d) (ymd (C.julian_easter y)))
+    cases
+
+let test_gregorian_invariants_exhaustive () =
+  (* the confidence-to-9999 guarantee: EVERY year's Easter is a Sunday in
+     [Mar 22, Apr 25] inclusive. *)
+  for y = 1583 to 9999 do
+    let e = C.gregorian_easter y in
+    Alcotest.(check bool) (Printf.sprintf "%d Easter is Sunday" y) true (D.weekday e = D.Sun);
+    let _, m, d = ymd e in
+    let ok = (m = 3 && d >= 22) || (m = 4 && d <= 25) in
+    Alcotest.(check bool) (Printf.sprintf "%d Easter in [Mar22,Apr25]" y) true ok
+  done
+
+let suite =
+  ( "Computus",
+    [ Alcotest.test_case "Gregorian known dates" `Quick test_gregorian_known;
+      Alcotest.test_case "Julian known dates" `Quick test_julian_known;
+      Alcotest.test_case "Gregorian invariants 1583..9999" `Slow test_gregorian_invariants_exhaustive ] )