2 files changed, 129 insertions, 0 deletions
diff --git a/lib/kernel/precedence.ml b/lib/kernel/precedence.ml
new file mode 100644
index 0000000..05ad69f
--- /dev/null
+++ b/lib/kernel/precedence.ml
@@ -0,0 +1,69 @@
+(* The rite-parameterised resolver. RG 91 says who wins; RG 92-95 says what
+   happens to the loser; RG 108-111 says how many commemorations are admitted.
+   Three separate functions, because the loser's fate depends on the loser's own
+   rank, not the winner's. *)
+open Sexplib0.Sexp_conv
+
+type origin = Temporal | Sanctoral [@@deriving sexp]
+type privilege = Privileged | Ordinary [@@deriving sexp]
+type disposition = Omit | Commemorate of privilege | Transfer | Repose [@@deriving sexp]
+
+type 'r candidate = { cel : 'r Celebration.t; origin : origin } [@@deriving sexp]
+
+type 's context = { date : Date.t; season : 's; weekday : Date.weekday }
+
+type ('s, 'r) rules = {
+  band : 's context -> 'r candidate -> int;
+  disposition : winner:'r candidate -> loser:'r candidate -> disposition;
+  admit :
+    observed:'r candidate ->
+    ('r candidate * privilege) list ->
+    ('r candidate * privilege) list;
+}
+
+type 'r resolution = {
+  observed : 'r candidate;
+  commemorations : ('r candidate * privilege) list;
+  deferred : 'r candidate list;
+  omitted : ('r candidate * string) list;
+}
+
+(* Ties break on slug so the result never depends on input order. *)
+let compare_by rules ctx a b =
+  let ba = rules.band ctx a and bb = rules.band ctx b in
+  if ba <> bb then Int.compare ba bb
+  else Slug.compare a.cel.Celebration.slug b.cel.Celebration.slug
+
+let resolve rules ctx ~temporal ~sanctoral =
+  (* A commemoration-only entry can never be observed (see Celebration.status),
+     so it is held out of the contest entirely rather than relying on its band. *)
+  let eligible, forced_comm =
+    List.partition
+      (fun c -> c.cel.Celebration.status = Celebration.Feast)
+      sanctoral
+  in
+  let sorted = List.stable_sort (compare_by rules ctx) (temporal :: eligible) in
+  let observed = List.hd sorted in
+  let losers = List.tl sorted @ forced_comm in
+  let comms, deferred, omitted =
+    List.fold_left
+      (fun (comms, defs, omits) l ->
+        match rules.disposition ~winner:observed ~loser:l with
+        | Commemorate p -> ((l, p) :: comms, defs, omits)
+        | Transfer | Repose -> (comms, l :: defs, omits)
+        | Omit -> (comms, defs, (l, "omitted: yielded to a higher day") :: omits))
+      ([], [], []) losers
+  in
+  let comms = List.rev comms and deferred = List.rev deferred in
+  let admitted = rules.admit ~observed comms in
+  let dropped =
+    List.filter (fun c -> not (List.exists (fun a -> fst a == fst c) admitted)) comms
+  in
+  {
+    observed;
+    commemorations = admitted;
+    deferred;
+    omitted =
+      List.rev omitted
+      @ List.map (fun (c, _) -> (c, "omitted: admission limit reached")) dropped;
+  }
diff --git a/lib/kernel/precedence.mli b/lib/kernel/precedence.mli
new file mode 100644
index 0000000..d30e5c3
--- /dev/null
+++ b/lib/kernel/precedence.mli
@@ -0,0 +1,60 @@
+(** The rite-parameterised resolver: RG 91 says who wins, RG 92-95 says what
+    happens to the loser, RG 108-111 says how many commemorations are admitted.
+    Three separate rite-supplied functions, because the loser's fate depends on
+    the loser's own rank, not the winner's -- conflating them would resist
+    extension to a second rite. *)
+
+(** Which of the day's two office streams a candidate came from. *)
+type origin = Temporal | Sanctoral [@@deriving sexp]
+
+(** RG 111: an admitted commemoration's own standing, distinct from its rank. *)
+type privilege = Privileged | Ordinary [@@deriving sexp]
+
+(** What becomes of a losing candidate. *)
+type disposition =
+  | Omit  (** yields with no trace in the day's celebration *)
+  | Commemorate of privilege  (** kept as a commemoration of the observed day *)
+  | Transfer  (** moved to the next free day (RG 92-95) *)
+  | Repose  (** kept only in a votive/private sense; not commemorated today *)
+[@@deriving sexp]
+
+(** A celebration together with the office stream it was drawn from. Parameterised
+    by the rite's rank type only, matching {!Celebration.t}. *)
+type 'r candidate = { cel : 'r Celebration.t; origin : origin } [@@deriving sexp]
+
+(** The day a resolution is computed for. Parameterised by the rite's season
+    type only -- a context has no rank of its own. *)
+type 's context = { date : Date.t; season : 's; weekday : Date.weekday }
+
+(** The rite's three resolution functions. *)
+type ('s, 'r) rules = {
+  band : 's context -> 'r candidate -> int;
+      (** RG 91: orders candidates for the day; lower wins. *)
+  disposition : winner:'r candidate -> loser:'r candidate -> disposition;
+      (** RG 92-95: the loser's fate, which depends on the loser's own rank. *)
+  admit :
+    observed:'r candidate ->
+    ('r candidate * privilege) list ->
+    ('r candidate * privilege) list;
+      (** RG 108-111: how many commemorations are admitted, and in what order;
+          anything filtered out here is recorded in {!resolution.omitted}, not
+          dropped. *)
+}
+
+(** The outcome of resolving one day's candidates. *)
+type 'r resolution = {
+  observed : 'r candidate;
+  commemorations : ('r candidate * privilege) list;
+  deferred : 'r candidate list;
+  omitted : ('r candidate * string) list;  (** each with a reason *)
+}
+
+(** Total: the temporal candidate is passed separately, so there is no
+    empty-candidate case. Ties break on slug, so the result never depends on
+    input order. A [Commemoration_only] celebration is held out of the contest
+    and can never be [observed]. Every input candidate appears exactly once in
+    [observed], [commemorations], [deferred] or [omitted] — nothing is dropped
+    silently. *)
+val resolve :
+  ('s, 'r) rules -> 's context -> temporal:'r candidate ->
+  sanctoral:'r candidate list -> 'r resolution